Thought that I'll post the RTTL2OTT excel VBA code here for reference.
[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 Function checkDur(Duration) Select Case Duration Case "1" checkDur = "000" Case "2" checkDur = "001" Case "4" checkDur = "010" Case "8" checkDur = "011" Case "16" checkDur = "100" Case "32" checkDur = "101" End Select End Function Function writeNotes(notesList) ntsAry = Split(notesList, ",") numInstructions = UBound(ntsAry) - LBound(ntsAry) + 3 ' For i = LBound(ntsAry) To UBound(ntsAry) thisNote = ntsAry(i) ' note is [Duration]-Note-[Sharp]-[Dot]-[Octave] ' if first is num then duration, else note ' #, ., .. or num A = Left(thisNote, 1) curPos = 1 If A = CStr(Val(A)) Then curPos = curPos + 1 b = Mid(thisNote, curPos, 1) If b = CStr(Val(b)) Then A = A & b curPos = curPos + 1 End If thisNoteDur = checkDur(A) Else thisNoteDur = defaultDuration End If
thisNoteNot = UCase(Mid(thisNote, curPos, 1))
curPos = curPos + 1
b = ""
If Len(thisNote) >= curPos Then b = Mid(thisNote, curPos, 1)
If b = "#" Then
thisNoteSha = "#"
curPos = curPos + 1
Else
thisNoteSha = ""
End If
thisNoteNot = thisNoteNot & thisNoteSha
b = ""
If Len(thisNote) >= curPos Then b = Mid(thisNote, curPos, 1)
Select Case b
Case ".", ";", "&"
thisNoteDot = b
curPos = curPos + 1
Case Else
thisNoteDot = ""
End Select
If Len(thisNote) >= curPos Then
thisNoteOct = Mid(thisNote, curPos, 2)
Else
If thisNoteOct <> "" Then thisNoteOct = defaultOctave
End If
' if octave different, write a scale-instruction
If prevOct = "" And thisNoteOct <> "" Then
prevOct = thisNoteOct
FirstTime = True
End If
If prevOct <> thisNoteOct Or FirstTime Then
writeNotes = writeNotes & writeScale(thisNoteOct)
numInstructions = numInstructions + 1
FirstTime = False
End If
prevOct = thisNoteOct
writeNotes = writeNotes & writeNote(thisNoteNot, thisNoteDur, thisNoteDot)
' thisNoteDur = ""
' thisNoteDot = ""
Next
End Function
Function writeScale(Octave)
Select Case Octave
Case "4"
writeScale = "01000"
Case "5"
writeScale = "01001"
Case "6"
writeScale = "01010"
Case "7"
writeScale = "01011"
End Select
End Function
Function writeNote(Note, Duration, Dots)
' Instruction, Note Value, Duration, Duration specifier
writeNote = "001"
Select Case Note
Case "P"
writeNote = writeNote & "0000"
Case "C"
writeNote = writeNote & "0001"
Case "C#"
writeNote = writeNote & "0010"
Case "D"
writeNote = writeNote & "0011"
Case "D#"
writeNote = writeNote & "0100"
Case "E"
writeNote = writeNote & "0101"
Case "F"
writeNote = writeNote & "0110"
Case "F#"
writeNote = writeNote & "0111"
Case "G"
writeNote = writeNote & "1000"
Case "G#"
writeNote = writeNote & "1001"
Case "A"
writeNote = writeNote & "1010"
Case "A#"
writeNote = writeNote & "1011"
Case "B"
Case "H"
writeNote = writeNote & "1100"
End Select
writeNote = writeNote & Duration
Select Case Dots
Case "."
writeNote = writeNote & "01"
Case ";"
writeNote = writeNote & "10"
Case "&"
writeNote = writeNote & "11"
Case Else
writeNote = writeNote & "00"
End Select
End Function
Function countInstructions()
countInstructions = Dec2Bin(numInstructions, 8 )
End Function
Function writeEOF()
writeEOF = "0000000000000000"
End Function
Function writeFiller(mainString, modNumber, fillerChar)
writeFiller = mainString & String(Len(mainString) Mod modNumber, fillerChar)
End Function
Function fullBin2Txt(inputString As String) As String
' Debug.Print "?FullBin2Parts(""" & inputString & """)"
For i = 1 To Len(inputString) - 1 Step 4
fullBin2Txt = fullBin2Txt & Bin2Hex(Mid(inputString, i, 4))
Next
' Debug.Print fullBin2Txt
End Function
Function Bin2Hex(number As Variant) As Variant
Bin2Hex = Application.Run("ATPVBAEN.xla!BIN2HEX", number)
End Function
Function txt2ott(inputString As String) As String
For i = 1 To Len(inputString) - 1 Step 8
txt2ott = txt2ott & Chr(Bin2Dec(Mid(inputString, i, 8 )))
Next
' Debug.Print txt2ott
End Function
Function Bin2Dec(BinaryNumber As Variant) As Variant
Bin2Dec = Application.Run("ATPVBAEN.xla!BIN2DEC", BinaryNumber)
End Function
'**** Code End ******** [/CODE]
Also take a look at http://edtoon.com/rott/rott.zip where this is done thru java.
Comment by seby — Saturday, December 1, 2007 @ 13:42
Hello webmaster
I would like to share with you a link to your site
write me here preonrelt@mail.ru
Comment by Alexwebmaster — Tuesday, March 3, 2009 @ 18:24