This is my prototype. This is part 1
Posted in two parts because of limitations on forum.
Paste the code in an excel module and try it over. Hope it helps those searching for RTTL2OTT and RTTL2TXT converters.
Code:
'**** Code start ********
' **************************************************
' RTTL2OTT ver 1.0 (Crude prototype)
' ==================================
'
' Code by Seby Manalel
'
' Credits:
' Many People who taught me the tricks,
' LiveRock who made me write this code
' http://discussion.forum.nokia.com/forum/showthread.php?p=200010#post200010
' SMS Specs from forum.nokia.com
' RTTL Specs, BIN2HEX etc by Google search
' **************************************************
' Ensure that analysis toolpack addin is installed !
' ATPVBAEN.xla is required for BIN2HEX etc
' **************************************************
Dim defaultDuration As String ' globals
Dim thisNoteDur As String
Dim numInstructions As Integer
Dim defaultOctave
' Comes from writeNotes(); # notes + 3 + octave changes
Sub test()
Debug.Print rttl2txt("C:\AxelF.RTTL")
'To Do: Common Dialog file opening, save as etc.
End Sub
Function rttl2txt(FileName As String) As String
' Read rttl, convert to ott-text format
Dim fullBin As String, namePart As String
BaseName = Left(FileName, Len(FileName) - 4)
TXTFileName = BaseName & "TXT"
OTTFileName = BaseName & "OTT"
RTTLfile = FreeFile()
Open FileName For Input As RTTLfile
Line Input #1, fullRTTL
Close
' Debug.Print "RTTL Contents>" & vbCrLf & fullRTTL
partRTTL = Split(fullRTTL, ":")
namePart = partRTTL(0)
defaultPart = partRTTL(1)
notesPart = partRTTL(2)
defaults = Split(defaultPart, ",")
Notes = Split(notesPart, ",")
part1 = writeInitial() ' Initial Header
part2 = writeName(namePart) ' from NamePart
part3 = writePatternID() ' except pattern length
part5 = writeDefaults(defaults) ' from defaults[]
part6 = writeNotes(notesPart) ' from Notes[]
part4 = countInstructions() ' Will be done last, from part5 and part6
part7 = writeEOF() ' 00 00
fullBin = part1 & part2 & part3 & part4 & part5 & part6 & part7
fullBin = writeFiller(fullBin, 8, "0") ' Count and find MOD 8
rttl2txt = fullBin2Txt(fullBin) ' Convert bin to Hex strings, combine and return as ott-text
' Now write rttl2txt to a file say AxelF.txt
TXTFile = FreeFile()
Open TXTFileName For Output As TXTFile
Print #TXTFile, rttl2txt
Close
'TO DO: Check for file existing
ottstr = txt2ott(fullBin)
' Now write ottstr to a file say AxelF.ott
OTTFile = FreeFile()
Open OTTFileName For Output As OTTFile
Print #OTTFile, ottstr
Close
End Function
'Prototypes of functions
Function writeInitial() As String
' Command Parts, Command 1, Filler bit, Command 2, SONG TYPE
writeInitial = "00000010010010100011101001"
End Function
Function writeName(songName As String) As String
' NAME LENGTH (4 bits), char1 (8 bit each), char2, ..... so on
wr = Len(songName)
writeName = Dec2Bin(wr, 4) & text2Bin(songName)
End Function
Function Dec2Bin(number As Variant, Optional places As Variant) As Variant
Dec2Bin = Application.Run("ATPVBAEN.xla!DEC2BIN", number, places)
End Function
Function text2Bin(textStr As String) As String
lts = Len(textStr)
For i = 1 To lts
text2Bin = text2Bin & Dec2Bin(Asc(Mid(textStr, i, 1)), 8)
Next
End Function
Function writePatternID()
' song pattern, <pattern-header-id>, Pattern Part A-Part, Loop 0
writePatternID = "00000001000000000"
End Function
Function writeDefaults(defaultArray)
dAry = defaultArray
Octave = "01" ' default 5
bpm = "01000" ' default 63
defaultDuration = "011" ' 1/8 note
thisNoteDur = "011"
For i = LBound(dAry) To UBound(dAry)
defInst = Split(dAry(i), "=")
Select Case defInst(0)
Case "o"
' 010 + scale-val
defaultOctave = defInst(1)
Select Case defaultOctave
Case "4"
Octave = "00" ' Scale - 1
Case "5"
Octave = "01" ' Scale - 2
Case "6"
Octave = "10" ' Scale - 3
Case "7"
Octave = "11" ' Scale - 4
End Select
Case "b"
' 100 + bpm Value
Select Case defInst(1)
Case "25"
bpm = "00000"
Case "28"
bpm = "00001"
Case "31"
bpm = "00010"
Case "35"
bpm = "00011"
Case "40"
bpm = "00100"
Case "45"
bpm = "00101"
Case "50"
bpm = "00110"
Case "56"
bpm = "00111"
Case "63"
bpm = "01000"
Case "70"
bpm = "01001"
Case "80"
bpm = "01010"
Case "90"
bpm = "01011"
Case "100"
bpm = "01100"
Case "112"
bpm = "01101"
Case "125"
bpm = "01110"
Case "140"
bpm = "01111"
Case "160"
bpm = "10000"
Case "180"
bpm = "10001"
Case "200"
bpm = "10010"
Case "225"
bpm = "10011"
Case "250"
bpm = "10100"
Case "285"
bpm = "10101"
Case "320"
bpm = "10110"
Case "355"
bpm = "10111"
Case "400"
bpm = "11000"
Case "450"
bpm = "11001"
Case "500"
bpm = "11010"
Case "565"
bpm = "11011"
Case "635"
bpm = "11100"
Case "715"
bpm = "11101"
Case "800"
bpm = "11110"
Case "900"
bpm = "11111"
End Select
Case "d"
'do nothing now, just set the global Variables
defaultDuration = checkDur(defInst(1))
thisNoteDur = defaultDuration
End Select
Next
writeDefaults = writeDefaults & "010" & Octave ' Scale Instruction
writeDefaults = writeDefaults & "100" & bpm ' Tempo Instruction
writeDefaults = writeDefaults & "011001011000" ' Style , Volume
End Function
' End of Part 1