' BASIC PLAY macro to Z80 one-shot timer-based song data converter.
' By Tim Williams, 3-14-2009 (happy Pi day!).
'
' Output is an assembly code fragment containing the number of
' counts (at 4MHz) per half cycle, followed by the number of
' half cycles to count for one note. 65535 is a special value
' which produces no sound while counting, thereby giving a rest.
'
DEFINT A-Z
DIM Duration AS SINGLE, Length AS SINGLE, OldLength AS SINGLE
DIM NoteTime AS SINGLE, RestTime AS SINGLE, NoteCyc AS LONG
DIM NoteCyc(83) AS LONG, NoteFreq(83) AS SINGLE, NoteLetter(6)
DIM k AS STRING * 1
GOSUB ConvTables
OPEN COMMAND$ + ".PLY" FOR BINARY AS #1
OPEN "CONS:" FOR OUTPUT AS #2
DO
'Strip command byte
GET #1, , k: k = UCASE$(k)
Length = OldLength
SELECT CASE k
CASE "A" TO "G" 'Note
Note = NoteLetter(ASC(k) - 65) + Octave * 12
'Strip one byte, check for suffix
GET #1, , k: k = UCASE$(k)
SELECT CASE k
CASE "#", "+"
Note = Note + 1 'Sharp
CASE "-"
Note = Note - 1 'Flat
CASE "."
'Dotted note (single dotting only)
Length = Length * 1.5
CASE ELSE
SEEK #1, LOC(1) 'undo character grab
END SELECT
GOSUB WriteNote
CASE "L" 'Length
'Strip one to two digits
Number$ = ""
FOR i = 4 TO 0 STEP -1
GET #1, , k: k = UCASE$(k)
IF ASC(k) < 48 OR ASC(k) >= 58 THEN
SEEK #1, LOC(1) 'undo character grab
EXIT FOR
END IF
Number$ = Number$ + k
NEXT
IF i = 0 THEN PRINT "Too many digits in length!": ERROR 6
OldLength = 1 / VAL(Number$)
CASE "M" 'Duration/control
'Strip one byte
GET #1, , k: k = UCASE$(k)
SELECT CASE k
CASE "B", "F" 'Background or Foreground: N/A
CASE "N" 'Normal
Duration = .875
CASE "L" 'Legato
Duration = 1
CASE "S" 'Staccato
Duration = .75
END SELECT
CASE "N" 'Note (direct)
'Strip one to two digits
Number$ = ""
FOR i = 3 TO 0 STEP -1
GET #1, , k: k = UCASE$(k)
IF ASC(k) < 48 OR ASC(k) >= 58 THEN
SEEK #1, LOC(1) 'undo character grab
EXIT FOR
END IF
Number$ = Number$ + k
NEXT
Note = VAL(Number$)
IF i = 0 OR Note > 84 THEN PRINT "Too many digits in note!": ERROR 6
GOSUB WriteNote
CASE "O" 'Octave
'Strip one digit
GET #1, , k
Octave = VAL(k)
CASE "P" 'Rest (pause)
'Strip one to two digits
Number$ = ""
FOR i = 3 TO 0 STEP -1
GET #1, , k: k = UCASE$(k)
IF ASC(k) < 48 OR ASC(k) >= 58 THEN
SEEK #1, LOC(1) 'undo character grab
EXIT FOR
END IF
Number$ = Number$ + k
NEXT
IF i = 0 THEN PRINT "Too many digits in rest!": ERROR 6
Length = VAL(Number$)
IF Length < 1 OR Length > 63 THEN PRINT "Rest out of range!": ERROR 6
Length = 1 / Length
Note = 0
GOSUB WriteNote
CASE "T" 'Tempo
'Strip two to three digits
Number$ = ""
FOR i = 4 TO 0 STEP -1
GET #1, , k: k = UCASE$(k)
IF ASC(k) < 48 OR ASC(k) >= 58 THEN
SEEK #1, LOC(1) 'undo character grab
EXIT FOR
END IF
Number$ = Number$ + k
NEXT
IF i <= 0 THEN PRINT "Too many digits in tempo!": ERROR 6
Tempo = VAL(Number$)
IF Tempo < 32 OR Tempo > 255 THEN PRINT "Tempo out of range!": ERROR 6
CASE ">" 'Increase octave
IF Octave < 6 THEN Octave = Octave + 1
CASE "<" 'Decrease octave
IF Octave > 0 THEN Octave = Octave - 1
END SELECT
LOOP UNTIL EOF(1)
PRINT #2, "endtones:"
END
'
' Writes the specified note to #2.
'
WriteNote:
IF Note > 0 THEN
NoteCycles = NoteFreq(Note) * Duration * Length * 480 / Tempo
ELSE
NoteCycles = NoteFreq(Note) * Length * 240 / Tempo
END IF
IF NoteCycles > 65535 THEN NoteCyc = 65535
'SOUND NoteFreq(Note), NoteTime * 18.2
PRINT #2, CHR$(9) + CHR$(9) + ".word ";
IF Note = 0 THEN
' Rest
WRITE #2, NoteCyc(0), NoteCycles
ELSEIF Duration < .99 AND Note > 0 THEN
' Regular note plus brief rest
RestCycles = NoteFreq(0) * (1 - Duration) * Length * 240 / Tempo
WRITE #2, NoteCyc(Note), NoteCycles, NoteCyc(0), RestCycles
ELSE
'Duration = 1 (legato), note only
WRITE #2, NoteCyc(Note), NoteCycles
END IF
RETURN