Can anyone help me figure out this OPL-3 code? (GWBasic MIDI player) \ VOGONS

Can anyone help me figure out this OPL-3 code? (GWBasic MIDI player)

Topic actions

First post, by Peter Swinkels

Posted on 2022-08-06, 08:49

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

I found this GWBasic code at https://bisqwit.iki.fi/jutut/kuvat/programmin … s/midiplay.html :

1 0 REM MIDI PLAYER EXAMPLE PROGRAM COPYRIGHT (C) 2010 JOEL YLILUOMA
21 DEFINT A-Z: OPTION BASE 0: KEY OFF:   REM http://iki.fi/bisqwit/
3
42 DIM adl(180, 11), chins(17), chpan(17), chpit(17)
53 FOR i = 0 TO 180: FOR x = 0 TO 11: READ adl(i, x): NEXT x, i
64 GOTO 100 ' Begin program
7
85 'Set up OPL parameters (In: c = channel (0..17))
96 'Out: p=I/O port, q = per-OPL channel (0..8), o=operator offset
107 p = &H388 + 2 * (c\9): q = c MOD 9: o = (q MOD 3) + 8 * (q\3): RETURN
11
128 'OPL_NoteOff(c): c=channel. CHANGES: q,p,o
139 GOSUB 5: OUT p, &HB0 + q: OUT p+1, chpit(c) AND &HDF: RETURN
14
1510 'OPL_NoteOn(c,h#): c=channel,h#=hertz (0..131071). CHANGES: q,p,o,x
1611 GOSUB 5
1712 x = &H2000: WHILE h# >= 1023.5: h# = h#/2: x=x+&H400: WEND 'Calculate octave
1813 x = x + CINT(h#)
1914 OUT p, &HA0 + q: OUT p+1, x AND 255: x = x \ 256
2015 OUT p, &HB0 + q: OUT p+1, x: chpit(c) = x: RETURN
21
2216 'Technically, AdLib requires some delay between consecutive OUT commands.
2317 'However, BASIC is slow enough, that this is not an issue really.
2418 'The paradigm "OUT p,index: OUT p+1,value" works perfectly.
25
2620 'OPL_Touch(c,v): c=channel, v=volume. CHANGES: q,p,o,i,v
2721 'The formula below: SOLVE(V=127*127 * 2^( (A-63) / 8), A)
2822 IF v < 72 THEN v = 0 ELSE v = LOG(v) * 11.541561# - 48.818955#
2925 'OPL_Touch_Real(c,v): Same as OPL_Touch, except takes logarithmic volume.
3026 GOSUB 5: i = chins(c)
3127 OUT p, &H40+o: q = adl(i, 2): GOSUB 29
3228 OUT p, &H43+o: q = adl(i, 3)
3329 OUT p+1, (q OR 63) - v + ((q AND 63) * v) \ 63: RETURN
34
3530 'OPL_Patch(c): c=channel. CHANGES: q,p,o,x,i
3631 GOSUB 5: i = chins(c): q = p+1
3732 FOR x = 0 TO 1
3833  OUT p, &H20+o+x*3: OUT q, adl(i, 0+x)
3934  OUT p, &H60+o+x*3: OUT q, adl(i, 4+x)
4035  OUT p, &H80+o+x*3: OUT q, adl(i, 6+x)
4136  OUT p, &HE0+o+x*3: OUT q, adl(i, 8+x)
4237 NEXT: RETURN
43
4438 'OPL_Pan(c): c=channel. CHANGES: q,p,o
4539 GOSUB 5: OUT p, &HC0+q: OUT p+1, adl(chins(c),10)-chpan(c): RETURN
46
4740 'OPL_Reset(). CHANGES: c,q,p,o,x,y,v,i
4841 'Detect OPL3 (send pulses to timer, opl3 enable register)
4942 c=0: GOSUB 5: FOR y = 3 TO 4: OUT p, 4: OUT p+1, y*32: NEXT: ?INP(p)
5043 c=9: GOSUB 5: FOR y = 0 TO 2: OUT p, 5: OUT p+1, y AND 1: NEXT
5144 'Reset OPL3 (turn off all notes, set vital settings)
5245 c=0: GOSUB 5: OUT p, 1:  OUT p+1, 32 'Enable wave
5346 c=0: GOSUB 5: OUT p,&HBD:OUT p+1, 0  'Set melodic mode
5447 c=9: GOSUB 5: OUT p, 5:  OUT p+1, 1  'Enable OPL3
5548 c=9: GOSUB 5: OUT p, 4:  OUT p+1, 0  'Select mode 0 (also try 63 for fun!)
5650 'OPL_Silence(): Silence all OPL channels. CHANGES q,p,o,v,c,i
5751 v = 0: FOR c = 0 TO 17: GOSUB 8: GOSUB 25: NEXT: RETURN
58
5970 'ReadString(): Read N bytes from file. Input: x. Output: s$. CHANGES x
6071 s$ = "": WHILE x > 0: x = x - 1: GET #1: s$ = s$ + b$: WEND: RETURN

…Show last 531 lines

61
6275 'ReadVarLen(): Read variable length int from file. Output: x#. CHANGES x
6376 x# = 0
6477 GET #1: x = ASC(b$): x# = x# * 128 + (x AND 127): IF x >= 128 THEN 77
6578 RETURN
66
6780 'ConvertInteger(): Parses s$ as big-endian integer, stores to x#. CHANGES x
6881 x# = 0: FOR x=1 TO LEN(s$): x# = x# * 256 + ASC(MID$(s$, x, 1)): NEXT: RETURN
6982 'The reason why # (DOUBLE) is used to store integer values
7083 'is that GW-BASIC has only one integer type: INTEGER.
7184 'It supports values in the range -32768..+32737. Making it unsuitable
7285 'for storing values such as delta-times and track lengths, both of which
7386 'are often greater than +32767 in common MIDI files. QuickBASIC supports
7487 'the LONG datatype instead, but I was aiming for GW-BASIC compatibility
7588 'in order to utilize my cool syntax highlighter for the majority
7689 'of the duration of demonstrating this program on Youtube. :)
77
7894 'Ethical subroutine
7995 GOTO 97
8096 KILL filename$
8197 RETURN
82
83100 '*** MAIN MIDI PLAYER PROGRAM ***
84101 'Information about each track:
85102 DIM tkPtr%(100), tkDelay#(100), tkStatus(100), playwait#
86103 'The same, but for loop-beginning:
87104 DIM loPtr%(100), loDelay#(100), loStatus(100), loopwait#
88105 'The same, but cached just in case loop-beginning must be written:
89106 DIM rbPtr%(100), rbDelay#(100), rbStatus(100)
90
91109 'Persistent settings for each MIDI channel.
92110 DIM ChPatch(15), ChBend#(15), ChVolume(15), ChPanning(15), ChVibrato(15)
93
94120 'For each active note, we need the following:
95121 '    Original note number (ORIGINAL, not simulated)
96122 '       Keyoff      (Search Key)
97123 '       Aftertouch  (Search Key)
98124 '    Simulated note number
99125 '       Keyon -> OPL_NoteOn
100126 '       Bend  -> OPL_NoteOn
101127 '    Keyon/touch pressure
102128 '       Ctrl:Volume
103129 '    Adlib channel number
104130 '       All of above
105131 '    MIDI channel (multi search key)
106132 '       Bend
107133 '       Ctrl:Volume
108134 '       Ctrl:Pan
109140 DIM ActCount(15)      'number of active notes on each midi channel
110141 DIM ActTone(15,127)   'orignotenumber -> simulated notenumber
111142 DIM ActAdlChn(15,127) 'orignotenumber -> adlib channel
112143 DIM ActVol(15,127)    'orignotenumber -> pressure
113144 DIM ActRev(15,127)    'orignotenumber -> activeindex (index to ActList)
114145 DIM ActList(15,99)    'activeindex -> orignotenumber (index to ActVol etc)
115
116146 DIM chon(17),chage#(17)'adlchannel -> is_on,age (for channel allocation)
117148 DIM chm(17),cha(17)    'adlchannel -> midichn,activeindex (for collisions)
118149 DIM chx(17),chc(17)    'adlchannel -> x coordinate, color (for graphics)
119
120160 filename$ = "chmmr.mid" '<- FILENAME OF THE MIDI TO BE PLAYED
121161 GOSUB 40  ' Reset AdLib
122162 GOSUB 40  ' ...twice (just in case someone misprogrammed OPL3 previously)
123163 PLAYmode$  = "T255P64"
124164 PLAYmode%  = 255 * 64 'Event tick frequency
125165 PLAYbuflen = 2        'Number of events to keep buffered
126166 COLOR 8: CLS : txtline = 2: PRINT "Press Q to quit; Space to pause"
127169 GOSUB 200 ' Load and play MIDI file
128
129170 'Begin main program (this simply monitors the playing status)
130171 'Beware that the timer routine accesses a lot of global variables.
131172 paused = 0
132173 hlt(0) = &HCBF4' HLT; RETF.
133174   hlt = VARPTR(hlt(0))
134175   CALL hlt
135176   ' ^This subroutine saves power. It also makes DOSBox faster.
136177   ' However, QuickBASIC has a different syntax for calling ASM
137178   ' subroutines, so the line 175 will have to be changed when
138179   ' porting to QuickBASIC. Disable it, or try this (qb /Lqb.qlb):
139180   'DEF SEG = VARSEG(hlt(0)): CALL ABSOLUTE(hlt)
140
141182   y$ = INKEY$
142183   IF y$ <> " " THEN 186
143184   paused = 1 - paused
144185   IF paused THEN ? "Pause": PLAY STOP ELSE ? "Ok": PLAY ON
145186 IF y$ <> "q" AND y$ <> CHR$(27) AND y$ <> CHR$(3) THEN 174
146190 PLAY OFF: PRINT "End!": GOSUB 50: KEY ON: END
147
148200 'Subroutine: Load MIDI file
149210 OPEN filename$ FOR RANDOM AS #1 LEN = 1: FIELD #1, 1 AS b$  'Open file
150
151211 'QuickBASIC has BINARY access mode, which allows to use INPUT$() rather
152212 'than the silly fixed-size GET command, but GW-BASIC does not support
153213 'BINARY, so we use RANDOM here. The difference between BINARY and INPUT
154214 'is that INPUT chokes on EOF characters and translates CRLFs, making it
155215 'unsuitable for working with MIDI files.
156
157220 x = 4: GOSUB 70: IF s$ <> "MThd" THEN ERROR 13'Invalid type file
158230 x = 4: GOSUB 70: GOSUB 80: IF x# <> 6 THEN ERROR 13
159231 x = 2: GOSUB 70: GOSUB 80: Fmt        = x#
160232 x = 2: GOSUB 70: GOSUB 80: TrackCount = x#: IF TrackCount>100 THEN ERROR 6
161233 x = 2: GOSUB 70: GOSUB 80: DeltaTicks = x#
162234 InvDeltaTicks# = PLAYmode% / (240000000# * DeltaTicks)
163240 Tempo# = 1000000# * InvDeltaTicks#
164241 bendsense# = 2 / 8192#
165250 FOR tk = 1 TO TrackCount
166251   x = 4: GOSUB 70: IF s$ <> "MTrk" THEN ERROR 13'Invalid type file
167252   x = 4: GOSUB 70: GOSUB 80: TrackLength% = x#: y% = LOC(1)
168253   GOSUB 75: tkDelay#(tk) = x# 'Read next event time
169254   tkPtr%(tk) = LOC(1)         'Save first event file position
170255   GET #1, y% + TrackLength%   'Skip to beginning of next track header
171270 NEXT
172275 FOR a = 0 TO 15: ChVolume(a) = 127: NEXT
173281 PLAY ON: ON PLAY(PLAYbuflen) GOSUB 300 'Set up periodic event handler
174282 began = 0: loopStart = 1: playwait# = 0: PLAY "MLMB"
175
176300 'Subroutine: Timer callback. Called when the PLAY buffer is exhausted.
177301 IF began THEN playwait# = playwait# - 1#
178302 'For each track where delay=0, parse events and read new delay.
179303 WHILE playwait# < .5#: GOSUB 310: WEND
180304 'Repopulate the PLAY buffer
181305 WHILE PLAY(0) < PLAYbuflen: PLAY PLAYmode$: WEND: RETURN
182
183310 'Subroutine: Process events on any track that is due
184311 FOR tk = 1 TO TrackCount
185312   rbPtr%(tk)   = tkPtr%(tk)
186313   rbDelay#(tk) = tkDelay#(tk)
187314   rbStatus(tk) = tkStatus(tk)
188315   IF tkStatus(tk) < 0 OR tkDelay#(tk) > 0 THEN 319
189316   GOSUB 350                                  'Handle event
190317   GOSUB 75: tkDelay#(tk) = tkDelay#(tk) + x# 'Read next event time
191318   tkPtr%(tk) = LOC(1)                        'Save modified file position
192319 NEXT
193320 IF loopStart = 0 THEN 338
194321   'Save loop begin
195322   FOR tk = 1 TO TrackCount
196323     loPtr%(tk)   = rbPtr%(tk)
197324     loDelay#(tk) = rbDelay#(tk)
198325     loStatus(tk) = rbStatus(tk)
199326   NEXT
200327   loopwait# = playwait#
201328   loopStart = 0
202329   GOTO 338
203330   'Return to loop beginning
204331   FOR tk = 1 TO TrackCount
205332     tkPtr%(tk)   = loPtr%(tk)
206333     tkDelay#(tk) = loDelay#(tk)
207334     tkStatus(tk) = loStatus(tk)
208335   NEXT
209336   loopEnd   = 0
210337   playwait# = loopwait#
211338 'Find shortest delay from all tracks
212339 nd# = -1
213340 FOR tk = 1 TO TrackCount
214341   IF tkStatus(tk) < 0 THEN 343
215342   IF nd# = -1 OR tkDelay#(tk) < nd# THEN nd# = tkDelay#(tk)
216343 NEXT
217344 'Schedule the next playevent to be processed after that delay
218345 FOR tk = 1 TO TrackCount: tkDelay#(tk) = tkDelay#(tk) - nd#: NEXT
219346 t# = nd# * Tempo#: IF began THEN playwait# = playwait# + t#
220347 FOR a = 0 TO 17: chage#(a) = chage#(a) + t#: NEXT
221348 IF t# < 0 OR loopEnd THEN 330 ELSE RETURN 'Loop or done
222
223350 'Subroutine: Read an event from track, and read next delay. Input: tk
224
225351 'Note that we continuously access the disk file during playback.
226352 'This is perfectly fine when we are running on a modern OS, possibly
227353 'under the encapsulation of DOSBox, but if you're running this on
228354 'vanilla MS-DOS without e.g. SMARTDRV, you are going to find this
229355 'program very unsuitable for your MIDI playing needs, for the disk
230356 'drive would probably make more noise than the soundcard does.
231357 'We cannot cache tracks because of memory constraints in GW-BASIC.
232358 'In QBASIC, we could do better, but it would be cumbersome to implement.
233
234359 GET #1, tkPtr%(tk) + 1: b = ASC(b$)
235360 IF b < &HF0 THEN 380
236361 'Subroutine for Fx special events
237362 '? tk;":";HEX$(b);" at $";hex$(LOC(1))
238363 IF b = &HF7 OR b = &HF0 THEN 76'SysEx. Ignore Varlen.
239364 IF b = &HF3 THEN GET #1: RETURN
240365 IF b = &HF2 THEN GET #1: GET #1: RETURN
241370 'Subroutine for special event FF
242371 GET #1: evtype = ASC(b$): GOSUB 75: x = x#: GOSUB 70
243372 IF evtype = &H2F THEN tkStatus(tk) = -1
244373 IF evtype = &H51 THEN GOSUB 80: Tempo# = x# * InvDeltaTicks#
245374 IF evtype = 6 AND s$ = "loopStart" THEN loopStart = 1
246375 IF evtype = 6 AND s$ = "loopEnd"   THEN loopEnd   = 1
247376 IF evtype < 1 OR evtype > 6 THEN RETURN
248377 txtline = 3 + (txtline - 2) MOD 20
249378 LOCATE txtline, 1: COLOR 8: PRINT "Meta"; evtype; ": "; s$: RETURN
250
251380 'Subroutine for any normal event (80..EF)
252381 IF b < 128 THEN b = tkStatus(tk) OR &H80: GET #1, tkPtr%(tk)
253382 MidCh = b AND 15: tkStatus(tk) = b
254383 '? tk;":";HEX$(b);" at $";hex$(LOC(1))
255384 ON b\16 - 7 GOTO 400,420,460,470,490,492,495  'Choose event handler
256
257400 'Event: 8x Note Off
258401 GET #1: note = ASC(b$): GET #1': vol=ASC(b$)
259402 ChBend#(MidCh) = 0
260403 n = ActRev(MidCh,note): IF n = 0 THEN RETURN
261404 m = MidCh: GOTO 600 'deallocate active note, and return
262
263420 'Event: 9x Note On
264421 GET #1: note = ASC(b$): GET #1: vol = ASC(b$)
265422 IF vol = 0 THEN 402' Sometimes noteoffs are optimized as 0-vol noteons
266423 IF ActRev(MidCh,note) THEN RETURN 'Ignore repeat notes w/o keyoffs
267424 'Determine the instrument and the note value (tone)
268425 tone = note: i = ChPatch(MidCh)
269426 IF MidCh = 9 THEN i = 128+note-35: tone = adl(i,11) 'Translate percussion
270427 '(MIDI channel 9 always plays percussion and ignores the patch number)
271429 'Allocate AdLib channel (the physical sound channel for the note)
272430 bs# = -9: c = -1
273431 FOR a = 0 TO 17
274432  s# = chage#(a)
275433  IF chon(a)  = 0 THEN s# = s# + 3d3  ' Empty channel = privileged
276434  IF chins(a) = i THEN s# = s# + .2#  ' Same instrument = good
277435  IF i<128 AND chins(a)>127 THEN s# = s#*2+9'Percussion is inferior to melody
278436  IF s# > bs# THEN bs# = s#: c = a  ' Best candidate wins
279437 NEXT
280438 IF chon(c) THEN m=chm(c): n=cha(c): GOSUB 600  'Collision: Kill old note
281439 chon(c) = 1: chins(c) = i: chage#(c) = 0: began = 1
282440 'Allocate active note for MIDI channel
283441 '"Active note" helps dealing with further events affecting this note.
284442 n = ActCount(MidCh) + 1
285443 ActList(MidCh, n)     = note
286444 ActRev(MidCh,note)    = n
287445 ActCount(MidCh)       = n
288449 'Record info about this note
289450 ActTone(MidCh,note)   = tone
290451 ActAdlChn(MidCh,note) = c
291452 ActVol(MidCh,note)    = vol
292453 chm(c) = MidCh: cha(c) = n ' Save this note's origin so collision works.
293454 GOSUB 30 ' OPL_Patch
294455 GOSUB 530' OPL_Pan with ChPanning
295456 GOSUB 540' OPL_Touch with ChVolume
296457 chx(c) = 1 + (tone+63)MOD 80: chc(c) = 9+(chins(c)MOD 6)
297458 LOCATE 20-c, chx(c): COLOR chc(c): PRINT "#";
298459 GOTO 520 ' OPL_NoteOn with ChBend, and return
299
300460 'Event: Ax Note touch
301461 GET #1: note = ASC(b$): GET #1: vol = ASC(b$)
302462 IF ActRev(MidCh,note) = 0 THEN RETURN'Ignore touch if note is not active
303463 c = ActAdlChn(MidCh,note)
304464 LOCATE 20-c, chx(c): COLOR chc(c): PRINT "&";
305465 ActVol(MidCh,note) = vol
306466 GOTO 540 'update note volume, and return
307
308470 'Event: Bx Controller change
309471 GET #1: ctrlno = ASC(b$): GET #1: value = ASC(b$)
310472 IF ctrlno =   1 THEN ChVibrato(MidCh) = value 'TODO: handle
311473 IF ctrlno =   6 THEN bendsense# = value / 8192#
312474 IF ctrlno =   7 THEN ChVolume(MidCh) = value: mop = 2: GOTO 500
313475 IF ctrlno =  10 THEN 482 'Pan
314476 IF ctrlno = 121 THEN 486 'Reset controllers
315477 IF ctrlno = 123 THEN mop=5: GOTO 500 'All notes off on channel
316478 'Other ctrls worth considering:
317479 '  0 = choose bank (bank+patch identifies the instrument)
318480 ' 64 = sustain pedal (when used, noteoff does not produce an adlib keyoff)
319481 RETURN
320482 'Ctrl 10: Alter the panning of the channel:
321483 p = 0: IF value < 48 THEN p = 32 ELSE IF value > 79 THEN p = 16
322484 ChPanning(MidCh) = p
323485 mop=4: GOTO 500
324486 'Ctrl 121: Reset all controllers to their default values.
325487 ChBend#(MidCh)=0: ChVibrato(MidCh)=0: ChPan(MidCh)=0
326488 mop=1: GOSUB 500: mop=2: GOSUB 500: mop=4: GOTO 500
327
328490 'Event: Cx Patch change
329491 GET #1: ChPatch(MidCh) = ASC(b$): RETURN
330
331492 'Event: Dx Channel after-touch
332493 GET #1: vol = ASC(b$): mop=3:GOTO 500 'TODO: Verify, is this correct action?
333
334495 'Event: Ex Wheel/bend
335496 GET #1: a = ASC(b$): GET #1
336497 ChBend#(MidCh) = (a + ASC(b$) * 128 - 8192) * bendsense#
337498 mop = 1: GOTO 500 'Update pitches, and return
338
339500 'Subroutine: Update all live notes. Input: MidCh,mop
340501 'Update when mop: 1=pitches; 2=volumes; 3=pressures; 4=pans, 5=off
341502 x1 = ActCount(MidCh)
342503 FOR a = 1 TO x1
343504   note = ActList(MidCh, a)
344505   c    = ActAdlChn(MidCh,note): ON mop GOSUB 508,509,510,530,511
345506 NEXT
346507 RETURN
347508 tone = ActTone(MidCh,note): GOTO 520
348509 vol  = ActVol(MidCh, note): GOTO 540
349510 ActVol(MidCh,note) = vol: GOTO 540
350511 m = MidCh: n = a: GOTO 600
351
352520 'Subroutine: Update note pitch. Input: c,MidCh,tone. CHANGES q,p,o,x,h#
353521 ' 907*2^(n/12) * (8363) / 44100
354522 h# = 172.00093# * EXP(.057762265#*(tone+ChBend#(MidCh))): GOTO 10'OPL_NoteOn
355
356530 'Subroutine: Update note pan. Input: c,MidCh
357531 chpan(c) = ChPanning(MidCh): GOTO 38 'OPL_Pan
358
359540 'Subroutine: Update note volume. Input: c,MidCh,vol. CHANGES q,p,o,v
360541 v = vol * ChVolume(MidCh): GOTO 20 'OPL_Touch
361
362600 'Subroutine: Deallocate active note (m = MidCh, n = index). CHANGES c,x,q
363601 'Uses m instead of MidCh because called also from alloc-collision code.
364602 x = ActCount(m)    ' Find how many active notes
365603 q = ActList(m,n)   ' q=note to be deactivated
366604 ActRev(m,q) = 0    ' that note is no more
367605 ActCount(m) = x-1  ' The list is now shorter
368606 c = ActAdlChn(m,q) ' But wait, which adlib channel was it on, again?
369607 chon(c)=0: chage#(c)=0: GOSUB 8'OPL_NoteOff
370608 LOCATE 20-c, chx(c): COLOR 1: PRINT ".";
371610 IF n = x THEN RETURN' Did we delete the last note?
372611 q = ActList(m,x)    ' q = last note in list
373612 ActList(m,n) = q    ' move into the deleted slot
374613 ActRev(m,q)  = n
375614 cha(ActAdlChn(m,q)) = n
376615 RETURN
377
378760 'This FM Instrument Data comes from Miles Sound System, as used
379761 'in the following PC games: Star Control III and Asterix, under
380762 'the name AIL (Audio Interface Library). Today, AIL has been
381763 'released as "open-source freeware" under the name Miles Sound System.
382764 'AIL was used in more than fifty PC games, but so far, I have found
383765 'this particular set of General MIDI FM patches only in SC3 and Asterix.
384766 'Other games using AIL used different sets of FM patches. There is no
385767 'particular reason for preferring this patch set, and in fact, the
386768 'descendant of this program, ADLMIDI, http://iki.fi/source/adlmidi.html ,
387769 'features a large set of different FM patch sets to choose from.
388
389773 'In the Youtube video, I enter this huge blob of DATA lines very quickly
390774 'by using a preprogrammed input TSR, "inputter", which I made just for
391775 'this purpose.
392776 'It inputs the inline command "COLOR 0,4", turning text into black on red,
393777 'and then starts entering DATA lines in an arbitrary geometrical fashion.
394778 'After inputting, the text color is reset to normal with "COLOR 7,0".
395779 'Of course, the whole time, the poor syntax highlighter TSR (synhili)
396780 'does its best to make sense of whatever is being displayed on the screen,
397781 'causing the text to stay red only for a short while, whereever the cursor
398782 'was last. The resulting effect looks very cool, and most importantly,
399783 'the long sequence of DATA gets input in a non-boring manner.
400
401790 'The data bytes are:
402791 ' [0,1] AM/VIB/EG/KSR/Multiple bits for carrier and modulator respectively
403792 ' [2,3] KSL/Attenuation settings    for carrier and modulator respectively
404793 ' [4,5] Attack and decay rates      for carrier and modulator respectively
405794 ' [6,7] Sustain and release rates   for carrier and modulator respectively
406795 ' [8,9] Wave select settings        for carrier and modulator respectively
407796 ' [10]  Feedback/connection bits    for the channel (also stereo/pan bits)
408797 ' [11]  For percussive instruments (GP35..GP87), the tone to play
409
410800 DATA   1,  1,143,  6,242,242,244,247,0,0, 56,  0: REM GM1:AcouGrandPiano
411801 DATA   1,  1, 75,  0,242,242,244,247,0,0, 56,  0: REM GM2:BrightAcouGrand
412802 DATA   1,  1, 73,  0,242,242,244,246,0,0, 56,  0: REM GM3:ElecGrandPiano
413803 DATA 129, 65, 18,  0,242,242,247,247,0,0, 54,  0: REM GM4:Honky-tonkPiano
414804 DATA   1,  1, 87,  0,241,242,247,247,0,0, 48,  0: REM GM5:Rhodes Piano
415805 DATA   1,  1,147,  0,241,242,247,247,0,0, 48,  0: REM GM6:Chorused Piano
416806 DATA   1, 22,128, 14,161,242,242,245,0,0, 56,  0: REM GM7:Harpsichord
417807 DATA   1,  1,146,  0,194,194,248,248,0,0, 58,  0: REM GM8:Clavinet
418808 DATA  12,129, 92,  0,246,243,244,245,0,0, 48,  0: REM GM9:Celesta
419809 DATA   7, 17,151,128,243,242,242,241,0,0, 50,  0: REM GM10:Glockenspiel
420810 DATA  23,  1, 33,  0, 84,244,244,244,0,0, 50,  0: REM GM11:Music box
421811 DATA 152,129, 98,  0,243,242,246,246,0,0, 48,  0: REM GM12:Vibraphone
422812 DATA  24,  1, 35,  0,246,231,246,247,0,0, 48,  0: REM GM13:Marimba
423813 DATA  21,  1,145,  0,246,246,246,246,0,0, 52,  0: REM GM14:Xylophone
424814 DATA  69,129, 89,128,211,163,243,243,0,0, 60,  0: REM GM15:Tubular Bells
425815 DATA   3,129, 73,128,117,181,245,245,1,0, 52,  0: REM GM16:Dulcimer
426816 DATA 113, 49,146,  0,246,241, 20,  7,0,0, 50,  0: REM GM17:Hammond Organ
427817 DATA 114, 48, 20,  0,199,199, 88,  8,0,0, 50,  0: REM GM18:Percussive Organ
428818 DATA 112,177, 68,  0,170,138, 24,  8,0,0, 52,  0: REM GM19:Rock Organ
429819 DATA  35,177,147,  0,151, 85, 35, 20,1,0, 52,  0: REM GM20:Church Organ
430820 DATA  97,177, 19,128,151, 85,  4,  4,1,0, 48,  0: REM GM21:Reed Organ
431821 DATA  36,177, 72,  0,152, 70, 42, 26,1,0, 60,  0: REM GM22:Accordion
432822 DATA  97, 33, 19,  0,145, 97,  6,  7,1,0, 58,  0: REM GM23:Harmonica
433823 DATA  33,161, 19,137,113, 97,  6,  7,0,0, 54,  0: REM GM24:Tango Accordion
434824 DATA   2, 65,156,128,243,243,148,200,1,0, 60,  0: REM GM25:Acoustic Guitar1
435825 DATA   3, 17, 84,  0,243,241,154,231,1,0, 60,  0: REM GM26:Acoustic Guitar2
436826 DATA  35, 33, 95,  0,241,242, 58,248,0,0, 48,  0: REM GM27:Electric Guitar1
437827 DATA   3, 33,135,128,246,243, 34,248,1,0, 54,  0: REM GM28:Electric Guitar2
438828 DATA   3, 33, 71,  0,249,246, 84, 58,0,0, 48,  0: REM GM29:Electric Guitar3
439829 DATA  35, 33, 74,  5,145,132, 65, 25,1,0, 56,  0: REM GM30:Overdrive Guitar
440830 DATA  35, 33, 74,  0,149,148, 25, 25,1,0, 56,  0: REM GM31:Distorton Guitar
441831 DATA   9,132,161,128, 32,209, 79,248,0,0, 56,  0: REM GM32:Guitar Harmonics
442832 DATA  33,162, 30,  0,148,195,  6,166,0,0, 50,  0: REM GM33:Acoustic Bass
443833 DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM34:Electric Bass 1
444834 DATA  49, 49,141,  0,241,241,232,120,0,0, 58,  0: REM GM35:Electric Bass 2
445835 DATA  49, 50, 91,  0, 81,113, 40, 72,0,0, 60,  0: REM GM36:Fretless Bass
446836 DATA   1, 33,139, 64,161,242,154,223,0,0, 56,  0: REM GM37:Slap Bass 1
447837 DATA  33, 33,139,  8,162,161, 22,223,0,0, 56,  0: REM GM38:Slap Bass 2
448838 DATA  49, 49,139,  0,244,241,232,120,0,0, 58,  0: REM GM39:Synth Bass 1
449839 DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM40:Synth Bass 2
450840 DATA  49, 33, 21,  0,221, 86, 19, 38,1,0, 56,  0: REM GM41:Violin
451841 DATA  49, 33, 22,  0,221,102, 19,  6,1,0, 56,  0: REM GM42:Viola
452842 DATA 113, 49, 73,  0,209, 97, 28, 12,1,0, 56,  0: REM GM43:Cello
453843 DATA  33, 35, 77,128,113,114, 18,  6,1,0, 50,  0: REM GM44:Contrabass
454844 DATA 241,225, 64,  0,241,111, 33, 22,1,0, 50,  0: REM GM45:Tremulo Strings
455845 DATA   2,  1, 26,128,245,133,117, 53,1,0, 48,  0: REM GM46:Pizzicato String
456846 DATA   2,  1, 29,128,245,243,117,244,1,0, 48,  0: REM GM47:Orchestral Harp
457847 DATA  16, 17, 65,  0,245,242,  5,195,1,0, 50,  0: REM GM48:Timpany
458848 DATA  33,162,155,  1,177,114, 37,  8,1,0, 62,  0: REM GM49:String Ensemble1
459849 DATA 161, 33,152,  0,127, 63,  3,  7,1,1, 48,  0: REM GM50:String Ensemble2
460850 DATA 161, 97,147,  0,193, 79, 18,  5,0,0, 58,  0: REM GM51:Synth Strings 1
461851 DATA  33, 97, 24,  0,193, 79, 34,  5,0,0, 60,  0: REM GM52:SynthStrings 2
462852 DATA  49,114, 91,131,244,138, 21,  5,0,0, 48,  0: REM GM53:Choir Aahs
463853 DATA 161, 97,144,  0,116,113, 57,103,0,0, 48,  0: REM GM54:Voice Oohs
464854 DATA 113,114, 87,  0, 84,122,  5,  5,0,0, 60,  0: REM GM55:Synth Voice
465855 DATA 144, 65,  0,  0, 84,165, 99, 69,0,0, 56,  0: REM GM56:Orchestra Hit
466856 DATA  33, 33,146,  1,133,143, 23,  9,0,0, 60,  0: REM GM57:Trumpet
467857 DATA  33, 33,148,  5,117,143, 23,  9,0,0, 60,  0: REM GM58:Trombone
468858 DATA  33, 97,148,  0,118,130, 21, 55,0,0, 60,  0: REM GM59:Tuba
469859 DATA  49, 33, 67,  0,158, 98, 23, 44,1,1, 50,  0: REM GM60:Muted Trumpet
470860 DATA  33, 33,155,  0, 97,127,106, 10,0,0, 50,  0: REM GM61:French Horn
471861 DATA  97, 34,138,  6,117,116, 31, 15,0,0, 56,  0: REM GM62:Brass Section
472862 DATA 161, 33,134,131,114,113, 85, 24,1,0, 48,  0: REM GM63:Synth Brass 1
473863 DATA  33, 33, 77,  0, 84,166, 60, 28,0,0, 56,  0: REM GM64:Synth Brass 2
474864 DATA  49, 97,143,  0,147,114,  2, 11,1,0, 56,  0: REM GM65:Soprano Sax
475865 DATA  49, 97,142,  0,147,114,  3,  9,1,0, 56,  0: REM GM66:Alto Sax
476866 DATA  49, 97,145,  0,147,130,  3,  9,1,0, 58,  0: REM GM67:Tenor Sax
477867 DATA  49, 97,142,  0,147,114, 15, 15,1,0, 58,  0: REM GM68:Baritone Sax
478868 DATA  33, 33, 75,  0,170,143, 22, 10,1,0, 56,  0: REM GM69:Oboe
479869 DATA  49, 33,144,  0,126,139, 23, 12,1,1, 54,  0: REM GM70:English Horn
480870 DATA  49, 50,129,  0,117, 97, 25, 25,1,0, 48,  0: REM GM71:Bassoon
481871 DATA  50, 33,144,  0,155,114, 33, 23,0,0, 52,  0: REM GM72:Clarinet
482872 DATA 225,225, 31,  0,133,101, 95, 26,0,0, 48,  0: REM GM73:Piccolo
483873 DATA 225,225, 70,  0,136,101, 95, 26,0,0, 48,  0: REM GM74:Flute
484874 DATA 161, 33,156,  0,117,117, 31, 10,0,0, 50,  0: REM GM75:Recorder
485875 DATA  49, 33,139,  0,132,101, 88, 26,0,0, 48,  0: REM GM76:Pan Flute
486876 DATA 225,161, 76,  0,102,101, 86, 38,0,0, 48,  0: REM GM77:Bottle Blow
487877 DATA  98,161,203,  0,118, 85, 70, 54,0,0, 48,  0: REM GM78:Shakuhachi
488878 DATA  98,161,153,  0, 87, 86,  7,  7,0,0, 59,  0: REM GM79:Whistle
489879 DATA  98,161,147,  0,119,118,  7,  7,0,0, 59,  0: REM GM80:Ocarina
490880 DATA  34, 33, 89,  0,255,255,  3, 15,2,0, 48,  0: REM GM81:Lead 1 squareea
491881 DATA  33, 33, 14,  0,255,255, 15, 15,1,1, 48,  0: REM GM82:Lead 2 sawtooth
492882 DATA  34, 33, 70,128,134,100, 85, 24,0,0, 48,  0: REM GM83:Lead 3 calliope
493883 DATA  33,161, 69,  0,102,150, 18, 10,0,0, 48,  0: REM GM84:Lead 4 chiff
494884 DATA  33, 34,139,  0,146,145, 42, 42,1,0, 48,  0: REM GM85:Lead 5 charang
495885 DATA 162, 97,158, 64,223,111,  5,  7,0,0, 50,  0: REM GM86:Lead 6 voice
496886 DATA  32, 96, 26,  0,239,143,  1,  6,0,2, 48,  0: REM GM87:Lead 7 fifths
497887 DATA  33, 33,143,128,241,244, 41,  9,0,0, 58,  0: REM GM88:Lead 8 brass
498888 DATA 119,161,165,  0, 83,160,148,  5,0,0, 50,  0: REM GM89:Pad 1 new age
499889 DATA  97,177, 31,128,168, 37, 17,  3,0,0, 58,  0: REM GM90:Pad 2 warm
500890 DATA  97, 97, 23,  0,145, 85, 52, 22,0,0, 60,  0: REM GM91:Pad 3 polysynth
501891 DATA 113,114, 93,  0, 84,106,  1,  3,0,0, 48,  0: REM GM92:Pad 4 choir
502892 DATA  33,162,151,  0, 33, 66, 67, 53,0,0, 56,  0: REM GM93:Pad 5 bowedpad
503893 DATA 161, 33, 28,  0,161, 49,119, 71,1,1, 48,  0: REM GM94:Pad 6 metallic
504894 DATA  33, 97,137,  3, 17, 66, 51, 37,0,0, 58,  0: REM GM95:Pad 7 halo
505895 DATA 161, 33, 21,  0, 17,207, 71,  7,1,0, 48,  0: REM GM96:Pad 8 sweep
506896 DATA  58, 81,206,  0,248,134,246,  2,0,0, 50,  0: REM GM97:FX 1 rain
507897 DATA  33, 33, 21,  0, 33, 65, 35, 19,1,0, 48,  0: REM GM98:FX 2 soundtrack
508898 DATA   6,  1, 91,  0,116,165,149,114,0,0, 48,  0: REM GM99:FX 3 crystal
509899 DATA  34, 97,146,131,177,242,129, 38,0,0, 60,  0: REM GM100:FX 4 atmosphere
510900 DATA  65, 66, 77,  0,241,242, 81,245,1,0, 48,  0: REM GM101:FX 5 brightness
511901 DATA  97,163,148,128, 17, 17, 81, 19,1,0, 54,  0: REM GM102:FX 6 goblins
512902 DATA  97,161,140,128, 17, 29, 49,  3,0,0, 54,  0: REM GM103:FX 7 echoes
513903 DATA 164, 97, 76,  0,243,129,115, 35,1,0, 52,  0: REM GM104:FX 8 sci-fi
514904 DATA   2,  7,133,  3,210,242, 83,246,0,1, 48,  0: REM GM105:Sitar
515905 DATA  17, 19, 12,128,163,162, 17,229,1,0, 48,  0: REM GM106:Banjo
516906 DATA  17, 17,  6,  0,246,242, 65,230,1,2, 52,  0: REM GM107:Shamisen
517907 DATA 147,145,145,  0,212,235, 50, 17,0,1, 56,  0: REM GM108:Koto
518908 DATA   4,  1, 79,  0,250,194, 86,  5,0,0, 60,  0: REM GM109:Kalimba
519909 DATA  33, 34, 73,  0,124,111, 32, 12,0,1, 54,  0: REM GM110:Bagpipe
520910 DATA  49, 33,133,  0,221, 86, 51, 22,1,0, 58,  0: REM GM111:Fiddle
521911 DATA  32, 33,  4,129,218,143,  5, 11,2,0, 54,  0: REM GM112:Shanai
522912 DATA   5,  3,106,128,241,195,229,229,0,0, 54,  0: REM GM113:Tinkle Bell
523913 DATA   7,  2, 21,  0,236,248, 38, 22,0,0, 58,  0: REM GM114:Agogo Bells
524914 DATA   5,  1,157,  0,103,223, 53,  5,0,0, 56,  0: REM GM115:Steel Drums
525915 DATA  24, 18,150,  0,250,248, 40,229,0,0, 58,  0: REM GM116:Woodblock
526916 DATA  16,  0,134,  3,168,250,  7,  3,0,0, 54,  0: REM GM117:Taiko Drum
527917 DATA  17, 16, 65,  3,248,243, 71,  3,2,0, 52,  0: REM GM118:Melodic Tom
528918 DATA   1, 16,142,  0,241,243,  6,  2,2,0, 62,  0: REM GM119:Synth Drum
529919 DATA  14,192,  0,  0, 31, 31,  0,255,0,3, 62,  0: REM GM120:Reverse Cymbal
530920 DATA   6,  3,128,136,248, 86, 36,132,0,2, 62,  0: REM GM121:Guitar FretNoise
531921 DATA  14,208,  0,  5,248, 52,  0,  4,0,3, 62,  0: REM GM122:Breath Noise
532922 DATA  14,192,  0,  0,246, 31,  0,  2,0,3, 62,  0: REM GM123:Seashore
533923 DATA 213,218,149, 64, 55, 86,163, 55,0,0, 48,  0: REM GM124:Bird Tweet
534924 DATA  53, 20, 92,  8,178,244, 97, 21,2,0, 58,  0: REM GM125:Telephone
535925 DATA  14,208,  0,  0,246, 79,  0,245,0,3, 62,  0: REM GM126:Helicopter
536926 DATA  38,228,  0,  0,255, 18,  1, 22,0,1, 62,  0: REM GM127:Applause/Noise
537927 DATA   0,  0,  0,  0,243,246,240,201,0,2, 62,  0: REM GM128:Gunshot
538928 DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP35:Ac Bass Drum
539929 DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP36:Bass Drum 1
540930 DATA   2, 17,  7,  0,249,248,255,255,0,0, 56, 52: REM GP37:Side Stick
541931 DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 48: REM GP38:Acoustic Snare
542932 DATA   0,  1,  2,  0,255,255,  7,  8,0,0, 48, 58: REM GP39:Hand Clap
543933 DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 60: REM GP40:Electric Snare
544934 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 47: REM GP41:Low Floor Tom
545935 DATA  12, 18,  0,  0,246,251,  8, 71,0,2, 58, 43: REM GP42:Closed High Hat
546936 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 49: REM GP43:High Floor Tom
547937 DATA  12, 18,  0,  5,246,123,  8, 71,0,2, 58, 43: REM GP44:Pedal High Hat
548938 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 51: REM GP45:Low Tom
549939 DATA  12, 18,  0,  0,246,203,  2, 67,0,2, 58, 43: REM GP46:Open High Hat
550940 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 54: REM GP47:Low-Mid Tom
551941 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 57: REM GP48:High-Mid Tom
552942 DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 72: REM GP49:Crash Cymbal 1
553943 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 60: REM GP50:High Tom
554944 DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 76: REM GP51:Ride Cymbal 1
555945 DATA  14,208,  0, 10,245,159, 48,  2,0,0, 62, 84: REM GP52:Chinese Cymbal
556946 DATA  14,  7, 10, 93,228,245,228,229,3,1, 54, 36: REM GP53:Ride Bell
557947 DATA   2,  5,  3, 10,180,151,  4,247,0,0, 62, 65: REM GP54:Tambourine
558948 DATA  78,158,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP55:Splash Cymbal
559949 DATA  17, 16, 69,  8,248,243, 55,  5,2,0, 56, 83: REM GP56:Cow Bell
560950 DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP57:Crash Cymbal 2
561951 DATA 128, 16,  0, 13,255,255,  3, 20,3,0, 60, 24: REM GP58:Vibraslap
562952 DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 77: REM GP59:Ride Cymbal 2
563953 DATA   6,  2, 11,  0,245,245, 12,  8,0,0, 54, 60: REM GP60:High Bongo
564954 DATA   1,  2,  0,  0,250,200,191,151,0,0, 55, 65: REM GP61:Low Bongo
565955 DATA   1,  1, 81,  0,250,250,135,183,0,0, 54, 59: REM GP62:Mute High Conga
566956 DATA   1,  2, 84,  0,250,248,141,184,0,0, 54, 51: REM GP63:Open High Conga
567957 DATA   1,  2, 89,  0,250,248,136,182,0,0, 54, 45: REM GP64:Low Conga
568958 DATA   1,  0,  0,  0,249,250, 10,  6,3,0, 62, 71: REM GP65:High Timbale
569959 DATA   0,  0,128,  0,249,246,137,108,3,0, 62, 60: REM GP66:Low Timbale
570960 DATA   3, 12,128,  8,248,246,136,182,3,0, 63, 58: REM GP67:High Agogo
571961 DATA   3, 12,133,  0,248,246,136,182,3,0, 63, 53: REM GP68:Low Agogo
572962 DATA  14,  0, 64,  8,118,119, 79, 24,0,2, 62, 64: REM GP69:Cabasa
573963 DATA  14,  3, 64,  0,200,155, 73,105,0,2, 62, 71: REM GP70:Maracas
574964 DATA 215,199,220,  0,173,141,  5,  5,3,0, 62, 61: REM GP71:Short Whistle
575965 DATA 215,199,220,  0,168,136,  4,  4,3,0, 62, 61: REM GP72:Long Whistle
576966 DATA 128, 17,  0,  0,246,103,  6, 23,3,3, 62, 44: REM GP73:Short Guiro
577967 DATA 128, 17,  0,  9,245, 70,  5, 22,2,3, 62, 40: REM GP74:Long Guiro
578968 DATA   6, 21, 63,  0,  0,247,244,245,0,0, 49, 69: REM GP75:Claves
579969 DATA   6, 18, 63,  0,  0,247,244,245,3,0, 48, 68: REM GP76:High Wood Block
580970 DATA   6, 18, 63,  0,  0,247,244,245,0,0, 49, 63: REM GP77:Low Wood Block
581971 DATA   1,  2, 88,  0,103,117,231,  7,0,0, 48, 74: REM GP78:Mute Cuica
582972 DATA  65, 66, 69,  8,248,117, 72,  5,0,0, 48, 60: REM GP79:Open Cuica
583973 DATA  10, 30, 64, 78,224,255,240,  5,3,0, 56, 80: REM GP80:Mute Triangle
584974 DATA  10, 30,124, 82,224,255,240,  2,3,0, 56, 64: REM GP81:Open Triangle
585975 DATA  14,  0, 64,  8,122,123, 74, 27,0,2, 62, 72: REM GP82
586976 DATA  14,  7, 10, 64,228, 85,228, 57,3,1, 54, 73: REM GP83
587977 DATA   5,  4,  5, 64,249,214, 50,165,3,0, 62, 70: REM GP84
588978 DATA   2, 21, 63,  0,  0,247,243,245,3,0, 56, 68: REM GP85
589979 DATA   1,  2, 79,  0,250,248,141,181,0,0, 55, 48: REM GP86
590980 DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 53: REM GP87

There are a lot of OUT statements for OPL-3 related stuff accessing some Yamaha chip. I can't find much documentation about the subject online. Does anyone know a few good sources documenting this chip?

My GitHub:
https://github.com/peterswinkels

Reply 1 of 8, by DerBaum

Posted on 2022-08-06, 10:13

DerBaum Offline

Rank Oldbie

Rank: Oldbie
Posts: 775
Joined: 2022-07-09, 12:24
Location: GER

Here is the Datasheet of the OPL3:
https://pdf1.alldatasheet.com/datasheet-pdf/v … ETC/YMF262.html

FCKGW-RHQQ2

Reply 2 of 8, by Peter Swinkels

Posted on 2022-08-06, 11:00

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

@DerBaum: Thank you, do you know of any other sources of information? Those that focus more on programming for the chip? Something with C or even assembly language examples would be nice.

My GitHub:
https://github.com/peterswinkels

Reply 3 of 8, by mkarcher

Posted on 2022-08-06, 11:21

mkarcher Offline

Rank l33t

Rank: l33t
Posts: 3587
Joined: 2019-01-19, 16:29
Location: Germany

I found http://www.shipbrook.net/jeff/sb.html for the OPL2 stuff quite usable, even back in the day when it was distributed as TXT file in BBS networks. There is one major quirk, though: This document perpetuates the popular belief, that OPL2-based PC sound cards can generate timer interrupts. This is false for all mainstream sound cards. The OPL2 indeed has a timer function that works perfectly even on PC sound cards. You can poll the timer output status bits whether a timer interrupt occurred. This is actually used to detect OPL2/OPL3 presence. But the timer interrupt output pin is generally not connected to anything, so you can't generate an interrupt on the PC CPU. Furthermore, most sources (including this one) claim the Adlib card to generate IRQ0 / INT08, which is not even accessible from an ISA card.

For OPL3, you might want to refer to https://www.fit.vutbr.cz/~arnost/opl/opl3.html .

Reply 4 of 8, by Peter Swinkels

Posted on 2022-08-06, 20:35

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

@mkarcher: thank you.

Can anyone explain these lines:

120 'OPL_Touch(c,v): c=channel, v=volume. CHANGES: q,p,o,i,v
221 'The formula below: SOLVE(V=127*127 * 2^( (A-63) / 8), A)
322 IF v < 72 THEN v = 0 ELSE v = LOG(v) * 11.541561# - 48.818955#

The volume specified by the v variable is recalculated but does anyone know why those exact fractional numbers are used? Also what does "A" in the comment stand for?

My GitHub:
https://github.com/peterswinkels

Reply 5 of 8, by mkarcher

Posted on 2022-08-06, 21:56

mkarcher Offline

Rank l33t

Rank: l33t
Posts: 3587
Joined: 2019-01-19, 16:29
Location: Germany

Peter Swinkels wrote on 2022-08-06, 20:35:
Can anyone explain these lines: […]
Show full quote

Can anyone explain these lines:
120 'OPL_Touch(c,v): c=channel, v=volume. CHANGES: q,p,o,i,v
221 'The formula below: SOLVE(V=127*127 * 2^( (A-63) / 8), A)
322 IF v < 72 THEN v = 0 ELSE v = LOG(v) * 11.541561# - 48.818955#
The volume specified by the v variable is recalculated but does anyone know why those exact fractional numbers are used? Also what does "A" in the comment stand for?

The comment is an instruction for a computer algebra system like Derive, Maple or Mathematica. Most likely Wolfram Alpha can do that, too, as it is based on Mathematica. The "A" is the value that is to be programmed into the "A"mplitude register of the OPL3 chips, whereas v is the "v"olume requested by the user. SOLVE(...,A) means that you should transform the formula that calculates V from A (and is to be found in an OPL3 specification) to the inverse formula that calculates A from V. The basic code doesn't use the name "A". "A" in that formula is the "new v", whereas "V" in that formula is the "old v". You don't need to have a computer algebra system, if you are fluent in school maths, though. I use LOG2 to mean the logarithm to the base of 2, and LN to mean the natural logarithm. Each line of my code block is derived from the previous line of the code block by the operation indicated in the comment. These operations generally do not change for which value pair of A an V this formula is true.

1V = 127*127 * 2^((A-63)/8)           : REM original formula
2V = 127*127 * 2^(A/8) / 2^(63/8)     : REM split the power term
3V = 127*127 * 2^(A/8) / 234.753      : calculated the fixed power of two
4V = 68.706 * 2^(A/8)                 : REM merged constants
5LOG2(V) = LOG2(68.706) + A/8         : REM LOG2(...) on both sides
6LN(V)/LN(2) = LN(68.706)/LN(2) + A/8 : REM apply the identity LOG2(x) = LN(x) / LN(2)
7LN(V) = LN(68.706) + A*LN(2)/8       : REM multiply both sides by LN(2)
8LN(V) = 4.2298 + A*0.08664           : REM calculate logarithms of constants
9LN(V) = 4.2298 + A/11.542            : REM 1/0.08664 = 11.542
1011.542 * LN(V) = 4.2298 * 11.542 + A : REM multiply both sides by 11.542
1111.542 * LN(V) = 48.818 + A          : REM perform the multiplication
1211.542 * LN(V) - 48.818 = A          : REM subtract 48.818 on both sides

I was too lazy to carry around enough decimal digits to achieve the same level of precision as the original formula, but knowing that LOG in basic is the natural logarithm (which I wrote as LN), you should immediately recognise that the final form of the relation between A and V is the formula in your basic program.

Reply 6 of 8, by Peter Swinkels

Posted on 2022-08-08, 19:24

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

@mkarcher: Thank you.

For anyone who lkes a challenge, I have been trying to untangle the GW-Basic code and this is the result:

1'1. Out: q = per-OPL channel (0..8)
2'2. LBOUND/UBOUND
3'3. Combine arrays into structures.
4'4. The program fails to return to the start of MIDI file.
5'   -It appears the ShortestDelay() function has to return -1 when the end of the MIDI file is reached.
6
7'$DYNAMIC
8DEFINT A-Z
9OPTION BASE 0
10OPTION EXPLICIT 'This program is 100% Quick Basic 4.5 compatible, but OPTION EXPLICIT is convenient when using VBDOS.
11
12CONST EVENTBUFFERSIZE = 2
13CONST EVENTTICKFREQUENCY = 16320
14CONST FALSE = 0
15CONST MEBEND = &HE0
16CONST MECONTROLLER = &HB0
17CONST MEINSTRUMENT = &HC0
18CONST MEMETA = &HFF
19CONST MENOTEOFF = &H80
20CONST MENOTEON = &H90
21CONST MEPOLYPHONIC = &HA0
22CONST MEPRESSURE = &HD0
23CONST MESONGPOSITION = &HF2
24CONST MESONGSELECT = &HF3
25CONST MESYSEXSTART = &HF0
26CONST MESYSEXEND = &HF7
27CONST MMEENDOFTRACK = &H2F
28CONST MMESETTEMPO = &H51
29CONST MMETCOPYRIGHT = &H2
30CONST MMETCUE = &H7
31CONST MMETGENERIC = &H1
32CONST MMETINSTRUMENT = &H4
33CONST MMETLYRIC = &H5
34CONST MMETMARKER = &H6
35CONST MMETTRACK = &H3
36CONST MOPOFF = 1
37CONST MOPPAN = 2
38CONST MOPPITCH = 3
39CONST MOPPRESSURE = 4
40CONST MOPVOLUME = 5
41CONST MTHDBLOCKDEFAULTLENGTH = &H6
42CONST OPLBASE = &H388
43CONST OPLENABLEOPL3 = &H1
44CONST OPLENABLEWAVE = &H20
45CONST OPLMEDOLICMODE = &H0
46CONST OPLMODE0 = &H0
47CONST SIGN14BIT = &H2000
48CONST TRUE = -1
49
50TYPE ChannelStr
51 ActiveIndex AS INTEGER
52 Age AS LONG
53 ColorV AS INTEGER
54 MIDIChannel AS INTEGER
55 IsOn AS INTEGER
56 x AS INTEGER
57END TYPE
58
59TYPE ChannelInstrumentStr
60 Instrument AS INTEGER

…Show last 1023 lines

61 Panning AS INTEGER
62 Pitch AS INTEGER
63END TYPE
64
65TYPE ChannelSettingsStr
66 Bend AS LONG
67 Volume AS INTEGER
68 Panning AS INTEGER
69 Patch AS INTEGER
70 Vibrato AS INTEGER
71END TYPE
72
73TYPE MIDIStr
74 BendSense AS DOUBLE
75 Format AS INTEGER
76 InvDeltaTicks AS DOUBLE
77 Tempo AS DOUBLE
78 TrackCount AS LONG
79END TYPE
80
81TYPE StatusStr
82 Began AS INTEGER
83 LoopEnd AS INTEGER
84 LoopStart AS INTEGER
85 LoopWait AS LONG
86 Paused AS INTEGER
87 PlayWait AS LONG
88END TYPE
89
90TYPE TrackStr
91 Delay AS LONG
92 Pointer AS LONG
93 Status AS INTEGER
94END TYPE
95
96DECLARE FUNCTION GetOctave# (Hertz AS DOUBLE)
97DECLARE FUNCTION GetShortestDelay& (TrackCount AS LONG)
98DECLARE FUNCTION ParseBEDWord& (Buffer AS STRING)
99DECLARE FUNCTION ParseBEWord (Buffer AS STRING)
100DECLARE FUNCTION ReadVariableLengthInteger& ()
101DECLARE FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
102DECLARE FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
103DECLARE FUNCTION SetUpOPL (Channel, Operator, q)
104DECLARE SUB ChangePanning (Channel, Value)
105DECLARE SUB ControllerChange (Channel, MIDI AS MIDIStr)
106DECLARE SUB DeallocateActiveNote (Channel, Note)
107DECLARE SUB Display (Row, Column, ColorV, Text AS STRING)
108DECLARE SUB GetInstrumentData ()
109DECLARE SUB HandleSpecialTrackEvent (Byte, Track, MIDI AS MIDIStr, Status AS StatusStr)
110DECLARE SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
111DECLARE SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
112DECLARE SUB Initialize (Status AS StatusStr)
113DECLARE SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
114DECLARE SUB NoteOff (Channel)
115DECLARE SUB NoteOn (Channel, Status AS StatusStr)
116DECLARE SUB NoteTouch (Channel)
117DECLARE SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
118DECLARE SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
119DECLARE SUB OPLNoteOff (Channel)
120DECLARE SUB OPLPatch (Channel)
121DECLARE SUB OPLReset ()
122DECLARE SUB OPLSilence ()
123DECLARE SUB OPLTouchReal (Channel, Volume)
124DECLARE SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
125DECLARE SUB ResetAllControllers (Channel)
126DECLARE SUB Quit ()
127DECLARE SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
128DECLARE SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
129DECLARE SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
130DECLARE SUB UpdateNotePan (ActiveChannel, Channel)
131DECLARE SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
132
133DIM MIDI AS MIDIStr
134DIM Status AS StatusStr
135
136DIM SHARED ActiveNoteCount(0 TO 15)
137DIM SHARED Adlib(0 TO 180, 0 TO 11)
138DIM SHARED Channels(0 TO 17) AS ChannelStr
139DIM SHARED ChannelInstruments(0 TO 17) AS ChannelInstrumentStr
140DIM SHARED ChannelSettings(0 TO 15) AS ChannelSettingsStr
141DIM SHARED Loops(0 TO 0) AS TrackStr
142DIM SHARED LoopsBackup(0 TO 0) AS TrackStr
143DIM SHARED Tracks(0 TO 0) AS TrackStr
144
145DIM SHARED ActTone(0 TO 15, 0 TO 127)   'orignotenumber -> simulated notenumber
146DIM SHARED ActAdlChn(0 TO 15, 0 TO 127) 'orignotenumber -> adlib channel
147DIM SHARED ActVol(0 TO 15, 0 TO 127)    'orignotenumber -> pressure
148DIM SHARED ActRev(0 TO 15, 0 TO 127)    'orignotenumber -> activeindex (index to ActList)
149DIM SHARED ActList(0 TO 15, 0 TO 99)    'activeindex -> orignotenumber (index to ActVol etc)
150
151 Initialize Status
152 CALL Main(MIDI, Status)
153 Quit
154 END
155
156PlayerLoop:
157 IF Status.Began THEN Status.PlayWait = Status.PlayWait - 1
158
159 DO WHILE Status.PlayWait = 0
160  ProcessTrackEvents MIDI, Status
161 LOOP
162 
163 DO WHILE PLAY(0) < EVENTBUFFERSIZE
164  PLAY "T255 P64"
165 LOOP
166
167 RETURN
168
169 'The data bytes are:
170 ' [0,1] AM/VIB/EG/KSR/Multiple bits for carrier and modulator respectively
171 ' [2,3] KSL/Attenuation settings    for carrier and modulator respectively
172 ' [4,5] Attack and decay rates      for carrier and modulator respectively
173 ' [6,7] Sustain and release rates   for carrier and modulator respectively
174 ' [8,9] Wave select settings        for carrier and modulator respectively
175 ' [10]  Feedback/connection bits    for the channel (also stereo/pan bits)
176 ' [11]  For percussive instruments (GP35..GP87), the tone to play
177
178Instruments:
179DATA   1,  1,143,  6,242,242,244,247,0,0, 56,  0: REM GM1:AcouGrandPiano
180DATA   1,  1, 75,  0,242,242,244,247,0,0, 56,  0: REM GM2:BrightAcouGrand
181DATA   1,  1, 73,  0,242,242,244,246,0,0, 56,  0: REM GM3:ElecGrandPiano
182DATA 129, 65, 18,  0,242,242,247,247,0,0, 54,  0: REM GM4:Honky-tonkPiano
183DATA   1,  1, 87,  0,241,242,247,247,0,0, 48,  0: REM GM5:Rhodes Piano
184DATA   1,  1,147,  0,241,242,247,247,0,0, 48,  0: REM GM6:Chorused Piano
185DATA   1, 22,128, 14,161,242,242,245,0,0, 56,  0: REM GM7:Harpsichord
186DATA   1,  1,146,  0,194,194,248,248,0,0, 58,  0: REM GM8:Clavinet
187DATA  12,129, 92,  0,246,243,244,245,0,0, 48,  0: REM GM9:Celesta
188DATA   7, 17,151,128,243,242,242,241,0,0, 50,  0: REM GM10:Glockenspiel
189DATA  23,  1, 33,  0, 84,244,244,244,0,0, 50,  0: REM GM11:Music box
190DATA 152,129, 98,  0,243,242,246,246,0,0, 48,  0: REM GM12:Vibraphone
191DATA  24,  1, 35,  0,246,231,246,247,0,0, 48,  0: REM GM13:Marimba
192DATA  21,  1,145,  0,246,246,246,246,0,0, 52,  0: REM GM14:Xylophone
193DATA  69,129, 89,128,211,163,243,243,0,0, 60,  0: REM GM15:Tubular Bells
194DATA   3,129, 73,128,117,181,245,245,1,0, 52,  0: REM GM16:Dulcimer
195DATA 113, 49,146,  0,246,241, 20,  7,0,0, 50,  0: REM GM17:Hammond Organ
196DATA 114, 48, 20,  0,199,199, 88,  8,0,0, 50,  0: REM GM18:Percussive Organ
197DATA 112,177, 68,  0,170,138, 24,  8,0,0, 52,  0: REM GM19:Rock Organ
198DATA  35,177,147,  0,151, 85, 35, 20,1,0, 52,  0: REM GM20:Church Organ
199DATA  97,177, 19,128,151, 85,  4,  4,1,0, 48,  0: REM GM21:Reed Organ
200DATA  36,177, 72,  0,152, 70, 42, 26,1,0, 60,  0: REM GM22:Accordion
201DATA  97, 33, 19,  0,145, 97,  6,  7,1,0, 58,  0: REM GM23:Harmonica
202DATA  33,161, 19,137,113, 97,  6,  7,0,0, 54,  0: REM GM24:Tango Accordion
203DATA   2, 65,156,128,243,243,148,200,1,0, 60,  0: REM GM25:Acoustic Guitar1
204DATA   3, 17, 84,  0,243,241,154,231,1,0, 60,  0: REM GM26:Acoustic Guitar2
205DATA  35, 33, 95,  0,241,242, 58,248,0,0, 48,  0: REM GM27:Electric Guitar1
206DATA   3, 33,135,128,246,243, 34,248,1,0, 54,  0: REM GM28:Electric Guitar2
207DATA   3, 33, 71,  0,249,246, 84, 58,0,0, 48,  0: REM GM29:Electric Guitar3
208DATA  35, 33, 74,  5,145,132, 65, 25,1,0, 56,  0: REM GM30:Overdrive Guitar
209DATA  35, 33, 74,  0,149,148, 25, 25,1,0, 56,  0: REM GM31:Distorton Guitar
210DATA   9,132,161,128, 32,209, 79,248,0,0, 56,  0: REM GM32:Guitar Harmonics
211DATA  33,162, 30,  0,148,195,  6,166,0,0, 50,  0: REM GM33:Acoustic Bass
212DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM34:Electric Bass 1
213DATA  49, 49,141,  0,241,241,232,120,0,0, 58,  0: REM GM35:Electric Bass 2
214DATA  49, 50, 91,  0, 81,113, 40, 72,0,0, 60,  0: REM GM36:Fretless Bass
215DATA   1, 33,139, 64,161,242,154,223,0,0, 56,  0: REM GM37:Slap Bass 1
216DATA  33, 33,139,  8,162,161, 22,223,0,0, 56,  0: REM GM38:Slap Bass 2
217DATA  49, 49,139,  0,244,241,232,120,0,0, 58,  0: REM GM39:Synth Bass 1
218DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM40:Synth Bass 2
219DATA  49, 33, 21,  0,221, 86, 19, 38,1,0, 56,  0: REM GM41:Violin
220DATA  49, 33, 22,  0,221,102, 19,  6,1,0, 56,  0: REM GM42:Viola
221DATA 113, 49, 73,  0,209, 97, 28, 12,1,0, 56,  0: REM GM43:Cello
222DATA  33, 35, 77,128,113,114, 18,  6,1,0, 50,  0: REM GM44:Contrabass
223DATA 241,225, 64,  0,241,111, 33, 22,1,0, 50,  0: REM GM45:Tremulo Strings
224DATA   2,  1, 26,128,245,133,117, 53,1,0, 48,  0: REM GM46:Pizzicato String
225DATA   2,  1, 29,128,245,243,117,244,1,0, 48,  0: REM GM47:Orchestral Harp
226DATA  16, 17, 65,  0,245,242,  5,195,1,0, 50,  0: REM GM48:Timpany
227DATA  33,162,155,  1,177,114, 37,  8,1,0, 62,  0: REM GM49:String Ensemble1
228DATA 161, 33,152,  0,127, 63,  3,  7,1,1, 48,  0: REM GM50:String Ensemble2
229DATA 161, 97,147,  0,193, 79, 18,  5,0,0, 58,  0: REM GM51:Synth Strings 1
230DATA  33, 97, 24,  0,193, 79, 34,  5,0,0, 60,  0: REM GM52:SynthStrings 2
231DATA  49,114, 91,131,244,138, 21,  5,0,0, 48,  0: REM GM53:Choir Aahs
232DATA 161, 97,144,  0,116,113, 57,103,0,0, 48,  0: REM GM54:Voice Oohs
233DATA 113,114, 87,  0, 84,122,  5,  5,0,0, 60,  0: REM GM55:Synth Voice
234DATA 144, 65,  0,  0, 84,165, 99, 69,0,0, 56,  0: REM GM56:Orchestra Hit
235DATA  33, 33,146,  1,133,143, 23,  9,0,0, 60,  0: REM GM57:Trumpet
236DATA  33, 33,148,  5,117,143, 23,  9,0,0, 60,  0: REM GM58:Trombone
237DATA  33, 97,148,  0,118,130, 21, 55,0,0, 60,  0: REM GM59:Tuba
238DATA  49, 33, 67,  0,158, 98, 23, 44,1,1, 50,  0: REM GM60:Muted Trumpet
239DATA  33, 33,155,  0, 97,127,106, 10,0,0, 50,  0: REM GM61:French Horn
240DATA  97, 34,138,  6,117,116, 31, 15,0,0, 56,  0: REM GM62:Brass Section
241DATA 161, 33,134,131,114,113, 85, 24,1,0, 48,  0: REM GM63:Synth Brass 1
242DATA  33, 33, 77,  0, 84,166, 60, 28,0,0, 56,  0: REM GM64:Synth Brass 2
243DATA  49, 97,143,  0,147,114,  2, 11,1,0, 56,  0: REM GM65:Soprano Sax
244DATA  49, 97,142,  0,147,114,  3,  9,1,0, 56,  0: REM GM66:Alto Sax
245DATA  49, 97,145,  0,147,130,  3,  9,1,0, 58,  0: REM GM67:Tenor Sax
246DATA  49, 97,142,  0,147,114, 15, 15,1,0, 58,  0: REM GM68:Baritone Sax
247DATA  33, 33, 75,  0,170,143, 22, 10,1,0, 56,  0: REM GM69:Oboe
248DATA  49, 33,144,  0,126,139, 23, 12,1,1, 54,  0: REM GM70:English Horn
249DATA  49, 50,129,  0,117, 97, 25, 25,1,0, 48,  0: REM GM71:Bassoon
250DATA  50, 33,144,  0,155,114, 33, 23,0,0, 52,  0: REM GM72:Clarinet
251DATA 225,225, 31,  0,133,101, 95, 26,0,0, 48,  0: REM GM73:Piccolo
252DATA 225,225, 70,  0,136,101, 95, 26,0,0, 48,  0: REM GM74:Flute
253DATA 161, 33,156,  0,117,117, 31, 10,0,0, 50,  0: REM GM75:Recorder
254DATA  49, 33,139,  0,132,101, 88, 26,0,0, 48,  0: REM GM76:Pan Flute
255DATA 225,161, 76,  0,102,101, 86, 38,0,0, 48,  0: REM GM77:Bottle Blow
256DATA  98,161,203,  0,118, 85, 70, 54,0,0, 48,  0: REM GM78:Shakuhachi
257DATA  98,161,153,  0, 87, 86,  7,  7,0,0, 59,  0: REM GM79:Whistle
258DATA  98,161,147,  0,119,118,  7,  7,0,0, 59,  0: REM GM80:Ocarina
259DATA  34, 33, 89,  0,255,255,  3, 15,2,0, 48,  0: REM GM81:Lead 1 squareea
260DATA  33, 33, 14,  0,255,255, 15, 15,1,1, 48,  0: REM GM82:Lead 2 sawtooth
261DATA  34, 33, 70,128,134,100, 85, 24,0,0, 48,  0: REM GM83:Lead 3 calliope
262DATA  33,161, 69,  0,102,150, 18, 10,0,0, 48,  0: REM GM84:Lead 4 chiff
263DATA  33, 34,139,  0,146,145, 42, 42,1,0, 48,  0: REM GM85:Lead 5 charang
264DATA 162, 97,158, 64,223,111,  5,  7,0,0, 50,  0: REM GM86:Lead 6 voice
265DATA  32, 96, 26,  0,239,143,  1,  6,0,2, 48,  0: REM GM87:Lead 7 fifths
266DATA  33, 33,143,128,241,244, 41,  9,0,0, 58,  0: REM GM88:Lead 8 brass
267DATA 119,161,165,  0, 83,160,148,  5,0,0, 50,  0: REM GM89:Pad 1 new age
268DATA  97,177, 31,128,168, 37, 17,  3,0,0, 58,  0: REM GM90:Pad 2 warm
269DATA  97, 97, 23,  0,145, 85, 52, 22,0,0, 60,  0: REM GM91:Pad 3 polysynth
270DATA 113,114, 93,  0, 84,106,  1,  3,0,0, 48,  0: REM GM92:Pad 4 choir
271DATA  33,162,151,  0, 33, 66, 67, 53,0,0, 56,  0: REM GM93:Pad 5 bowedpad
272DATA 161, 33, 28,  0,161, 49,119, 71,1,1, 48,  0: REM GM94:Pad 6 metallic
273DATA  33, 97,137,  3, 17, 66, 51, 37,0,0, 58,  0: REM GM95:Pad 7 halo
274DATA 161, 33, 21,  0, 17,207, 71,  7,1,0, 48,  0: REM GM96:Pad 8 sweep
275DATA  58, 81,206,  0,248,134,246,  2,0,0, 50,  0: REM GM97:FX 1 rain
276DATA  33, 33, 21,  0, 33, 65, 35, 19,1,0, 48,  0: REM GM98:FX 2 soundtrack
277DATA   6,  1, 91,  0,116,165,149,114,0,0, 48,  0: REM GM99:FX 3 crystal
278DATA  34, 97,146,131,177,242,129, 38,0,0, 60,  0: REM GM100:FX 4 atmosphere
279DATA  65, 66, 77,  0,241,242, 81,245,1,0, 48,  0: REM GM101:FX 5 brightness
280DATA  97,163,148,128, 17, 17, 81, 19,1,0, 54,  0: REM GM102:FX 6 goblins
281DATA  97,161,140,128, 17, 29, 49,  3,0,0, 54,  0: REM GM103:FX 7 echoes
282DATA 164, 97, 76,  0,243,129,115, 35,1,0, 52,  0: REM GM104:FX 8 sci-fi
283DATA   2,  7,133,  3,210,242, 83,246,0,1, 48,  0: REM GM105:Sitar
284DATA  17, 19, 12,128,163,162, 17,229,1,0, 48,  0: REM GM106:Banjo
285DATA  17, 17,  6,  0,246,242, 65,230,1,2, 52,  0: REM GM107:Shamisen
286DATA 147,145,145,  0,212,235, 50, 17,0,1, 56,  0: REM GM108:Koto
287DATA   4,  1, 79,  0,250,194, 86,  5,0,0, 60,  0: REM GM109:Kalimba
288DATA  33, 34, 73,  0,124,111, 32, 12,0,1, 54,  0: REM GM110:Bagpipe
289DATA  49, 33,133,  0,221, 86, 51, 22,1,0, 58,  0: REM GM111:Fiddle
290DATA  32, 33,  4,129,218,143,  5, 11,2,0, 54,  0: REM GM112:Shanai
291DATA   5,  3,106,128,241,195,229,229,0,0, 54,  0: REM GM113:Tinkle Bell
292DATA   7,  2, 21,  0,236,248, 38, 22,0,0, 58,  0: REM GM114:Agogo Bells
293DATA   5,  1,157,  0,103,223, 53,  5,0,0, 56,  0: REM GM115:Steel Drums
294DATA  24, 18,150,  0,250,248, 40,229,0,0, 58,  0: REM GM116:Woodblock
295DATA  16,  0,134,  3,168,250,  7,  3,0,0, 54,  0: REM GM117:Taiko Drum
296DATA  17, 16, 65,  3,248,243, 71,  3,2,0, 52,  0: REM GM118:Melodic Tom
297DATA   1, 16,142,  0,241,243,  6,  2,2,0, 62,  0: REM GM119:Synth Drum
298DATA  14,192,  0,  0, 31, 31,  0,255,0,3, 62,  0: REM GM120:Reverse Cymbal
299DATA   6,  3,128,136,248, 86, 36,132,0,2, 62,  0: REM GM121:Guitar FretNoise
300DATA  14,208,  0,  5,248, 52,  0,  4,0,3, 62,  0: REM GM122:Breath Noise
301DATA  14,192,  0,  0,246, 31,  0,  2,0,3, 62,  0: REM GM123:Seashore
302DATA 213,218,149, 64, 55, 86,163, 55,0,0, 48,  0: REM GM124:Bird Tweet
303DATA  53, 20, 92,  8,178,244, 97, 21,2,0, 58,  0: REM GM125:Telephone
304DATA  14,208,  0,  0,246, 79,  0,245,0,3, 62,  0: REM GM126:Helicopter
305DATA  38,228,  0,  0,255, 18,  1, 22,0,1, 62,  0: REM GM127:Applause/Noise
306DATA   0,  0,  0,  0,243,246,240,201,0,2, 62,  0: REM GM128:Gunshot
307DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP35:Ac Bass Drum
308DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP36:Bass Drum 1
309DATA   2, 17,  7,  0,249,248,255,255,0,0, 56, 52: REM GP37:Side Stick
310DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 48: REM GP38:Acoustic Snare
311DATA   0,  1,  2,  0,255,255,  7,  8,0,0, 48, 58: REM GP39:Hand Clap
312DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 60: REM GP40:Electric Snare
313DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 47: REM GP41:Low Floor Tom
314DATA  12, 18,  0,  0,246,251,  8, 71,0,2, 58, 43: REM GP42:Closed High Hat
315DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 49: REM GP43:High Floor Tom
316DATA  12, 18,  0,  5,246,123,  8, 71,0,2, 58, 43: REM GP44:Pedal High Hat
317DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 51: REM GP45:Low Tom
318DATA  12, 18,  0,  0,246,203,  2, 67,0,2, 58, 43: REM GP46:Open High Hat
319DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 54: REM GP47:Low-Mid Tom
320DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 57: REM GP48:High-Mid Tom
321DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 72: REM GP49:Crash Cymbal 1
322DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 60: REM GP50:High Tom
323DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 76: REM GP51:Ride Cymbal 1
324DATA  14,208,  0, 10,245,159, 48,  2,0,0, 62, 84: REM GP52:Chinese Cymbal
325DATA  14,  7, 10, 93,228,245,228,229,3,1, 54, 36: REM GP53:Ride Bell
326DATA   2,  5,  3, 10,180,151,  4,247,0,0, 62, 65: REM GP54:Tambourine
327DATA  78,158,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP55:Splash Cymbal
328DATA  17, 16, 69,  8,248,243, 55,  5,2,0, 56, 83: REM GP56:Cow Bell
329DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP57:Crash Cymbal 2
330DATA 128, 16,  0, 13,255,255,  3, 20,3,0, 60, 24: REM GP58:Vibraslap
331DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 77: REM GP59:Ride Cymbal 2
332DATA   6,  2, 11,  0,245,245, 12,  8,0,0, 54, 60: REM GP60:High Bongo
333DATA   1,  2,  0,  0,250,200,191,151,0,0, 55, 65: REM GP61:Low Bongo
334DATA   1,  1, 81,  0,250,250,135,183,0,0, 54, 59: REM GP62:Mute High Conga
335DATA   1,  2, 84,  0,250,248,141,184,0,0, 54, 51: REM GP63:Open High Conga
336DATA   1,  2, 89,  0,250,248,136,182,0,0, 54, 45: REM GP64:Low Conga
337DATA   1,  0,  0,  0,249,250, 10,  6,3,0, 62, 71: REM GP65:High Timbale
338DATA   0,  0,128,  0,249,246,137,108,3,0, 62, 60: REM GP66:Low Timbale
339DATA   3, 12,128,  8,248,246,136,182,3,0, 63, 58: REM GP67:High Agogo
340DATA   3, 12,133,  0,248,246,136,182,3,0, 63, 53: REM GP68:Low Agogo
341DATA  14,  0, 64,  8,118,119, 79, 24,0,2, 62, 64: REM GP69:Cabasa
342DATA  14,  3, 64,  0,200,155, 73,105,0,2, 62, 71: REM GP70:Maracas
343DATA 215,199,220,  0,173,141,  5,  5,3,0, 62, 61: REM GP71:Short Whistle
344DATA 215,199,220,  0,168,136,  4,  4,3,0, 62, 61: REM GP72:Long Whistle
345DATA 128, 17,  0,  0,246,103,  6, 23,3,3, 62, 44: REM GP73:Short Guiro
346DATA 128, 17,  0,  9,245, 70,  5, 22,2,3, 62, 40: REM GP74:Long Guiro
347DATA   6, 21, 63,  0,  0,247,244,245,0,0, 49, 69: REM GP75:Claves
348DATA   6, 18, 63,  0,  0,247,244,245,3,0, 48, 68: REM GP76:High Wood Block
349DATA   6, 18, 63,  0,  0,247,244,245,0,0, 49, 63: REM GP77:Low Wood Block
350DATA   1,  2, 88,  0,103,117,231,  7,0,0, 48, 74: REM GP78:Mute Cuica
351DATA  65, 66, 69,  8,248,117, 72,  5,0,0, 48, 60: REM GP79:Open Cuica
352DATA  10, 30, 64, 78,224,255,240,  5,3,0, 56, 80: REM GP80:Mute Triangle
353DATA  10, 30,124, 82,224,255,240,  2,3,0, 56, 64: REM GP81:Open Triangle
354DATA  14,  0, 64,  8,122,123, 74, 27,0,2, 62, 72: REM GP82
355DATA  14,  7, 10, 64,228, 85,228, 57,3,1, 54, 73: REM GP83
356DATA   5,  4,  5, 64,249,214, 50,165,3,0, 62, 70: REM GP84
357DATA   2, 21, 63,  0,  0,247,243,245,3,0, 56, 68: REM GP85
358DATA   1,  2, 79,  0,250,248,141,181,0,0, 55, 48: REM GP86
359DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 53: REM GP87
360
361REM $STATIC
362SUB ChangePanning (Channel, Value)
363DIM Panning
364
365';;;;;
366
367 Panning = &H0
368 IF Value < &H30 THEN
369  Panning = &H20
370 ELSEIF Value > &H4F THEN
371  Panning = &H10
372 END IF
373
374 ChannelSettings(Channel).Panning = Panning
375END SUB
376
377SUB ControllerChange (Channel, MIDI AS MIDIStr)
378DIM Controller
379DIM Value
380
381 Controller = ASC(INPUT$(&H1, 1))
382 Value = ASC(INPUT$(&H1, 1))
383
384';;;
385
386 SELECT CASE Controller
387  CASE &H1
388   ChannelSettings(Channel).Vibrato = Value
389  CASE &H6
390   MIDI.BendSense = Value / &H2000
391  CASE &H7
392   ChannelSettings(Channel).Volume = Value
393   UpdateAllLiveNotes Channel, MOPPAN, 0
394  CASE &HA
395   ChangePanning Channel, Value
396   UpdateAllLiveNotes Channel, MOPPAN, 0
397  CASE &H79
398   ResetAllControllers Channel
399   UpdateAllLiveNotes Channel, MOPPAN, 0
400  CASE &H7B
401   UpdateAllLiveNotes Channel, MOPVOLUME, 0
402 END SELECT
403END SUB
404
405SUB DeallocateActiveNote (Channel, Note)
406DIM ActiveNoteCount
407DIM DeactivatedNoteChannel
408DIM NoteToDeactivate
409
410 ActiveNoteCount = ActiveNoteCount(Channel)
411 NoteToDeactivate = ActList(Channel, Note)
412 ActRev(Channel, NoteToDeactivate) = 0
413 ActiveNoteCount(Channel) = ActiveNoteCount - 1
414 DeactivatedNoteChannel = ActAdlChn(Channel, NoteToDeactivate)
415 Channels(DeactivatedNoteChannel).IsOn = FALSE
416 Channels(DeactivatedNoteChannel).Age = 0
417 OPLNoteOff DeactivatedNoteChannel
418
419 Display 20 - DeactivatedNoteChannel, Channels(DeactivatedNoteChannel).x, 1, "."
420
421 IF NOT Note = ActiveNoteCount THEN
422  NoteToDeactivate = ActList(Channel, ActiveNoteCount)
423  ActList(Channel, Note) = NoteToDeactivate
424  ActRev(Channel, NoteToDeactivate) = Note
425  Channels(ActAdlChn(Channel, NoteToDeactivate)).ActiveIndex = Note
426 END IF
427END SUB
428
429SUB Display (Row, Column, ColorV, Text AS STRING)
430 COLOR ColorV
431 LOCATE Row, Column
432 PRINT Text;
433END SUB
434
435SUB GetInstrumentData ()
436DIM Column
437DIM Instrument
438
439 RESTORE Instruments
440 FOR Instrument = LBOUND(Adlib, 1) TO UBOUND(Adlib, 1)
441  FOR Column = LBOUND(Adlib, 2) TO UBOUND(Adlib, 2)
442   READ Adlib(Instrument, Column)
443  NEXT Column
444 NEXT Instrument
445END SUB
446
447FUNCTION GetOctave# (Hertz AS DOUBLE)
448DIM Octave AS DOUBLE
449
450'';;;
451
452 Octave = &H2000
453 DO WHILE Hertz >= 1023.5
454  Hertz = Hertz / 2
455  Octave = Octave + &H400
456 LOOP
457
458 GetOctave# = Octave + CINT(Hertz)
459END FUNCTION
460
461FUNCTION GetShortestDelay& (TrackCount AS LONG)
462DIM ShortestDelay AS LONG
463DIM Track
464
465 ShortestDelay = -1
466 FOR Track = 0 TO TrackCount - 1
467  IF Tracks(Track).Status >= 0 THEN
468   IF ShortestDelay = -1 OR Tracks(Track).Delay < ShortestDelay THEN
469    ShortestDelay = Tracks(Track).Delay
470   END IF
471  END IF
472 NEXT Track
473
474 GetShortestDelay& = ShortestDelay
475END FUNCTION
476
477SUB HandleSpecialTrackEvent (Byte, Track, MIDI AS MIDIStr, Status AS StatusStr)
478DIM Ignored AS LONG
479DIM StringV AS STRING
480
481 SELECT CASE Byte
482  CASE MESONGPOSITION
483   SEEK #1, SEEK(1) + &H2
484  CASE MESONGSELECT
485   SEEK #1, SEEK(1) + &H1
486  CASE MESYSEXSTART, MESYSEXEND
487   Ignored = ReadVariableLengthInteger&
488  CASE ELSE
489   HandleSpecialTrackMetaEvent Track, MIDI, Status
490 END SELECT
491END SUB
492
493SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
494DIM EventType
495DIM StringV AS STRING
496STATIC TextRow
497
498 EventType = ASC(INPUT$(&H1, 1))
499 StringV = INPUT$(ReadVariableLengthInteger&, 1)
500
501 SELECT CASE EventType
502  CASE MMETMARKER
503   IF StringV = "loopStart" THEN
504    Status.LoopStart = TRUE
505   ELSEIF StringV = "loopEnd" THEN
506    Status.LoopEnd = TRUE
507   END IF
508  CASE MMEENDOFTRACK
509   Tracks(Track).Status = -1 ';;;
510  CASE MMESETTEMPO
511   MIDI.Tempo = ParseBEDWord&(CHR$(&H0) + StringV) * MIDI.InvDeltaTicks
512 END SELECT
513
514 SELECT CASE EventType
515  CASE MMETCOPYRIGHT, MMETGENERIC, MMETINSTRUMENT, MMETLYRIC, MMETMARKER, MMETTRACK
516   IF TextRow = 0 THEN TextRow = 2
517   TextRow = 3 + (TextRow - 2) MOD 20
518   Display TextRow, 1, 8, "Meta" + STR$(EventType) + ": " + RemoveSpecialCharacters$(StringV)
519 END SELECT
520END SUB
521
522SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
523DIM Byte
524DIM Channel
525
526 SEEK #1, Tracks(Track).Pointer + &H1
527 Byte = ASC(INPUT$(&H1, 1))
528
529 IF Byte < MESYSEXSTART THEN
530  IF Byte < &H80 THEN '';;;;
531   Byte = Tracks(Track).Status OR &H80
532   SEEK #1, Tracks(Track).Pointer
533   SEEK #1, SEEK(1) + &H1
534  END IF
535
536  Channel = Byte AND &HF
537  Tracks(Track).Status = Byte
538  SELECT CASE Byte AND &HF0
539   CASE MENOTEOFF
540    NoteOff Channel
541   CASE MENOTEON
542    NoteOn Channel, Status
543   CASE MEPOLYPHONIC
544    NoteTouch Channel
545   CASE MECONTROLLER
546    ControllerChange Channel, MIDI
547   CASE MEINSTRUMENT
548    ChannelSettings(Channel).Patch = ASC(INPUT$(&H1, 1))
549   CASE MEPRESSURE
550    UpdateAllLiveNotes Channel, MOPPRESSURE, ASC(INPUT$(&H1, 1))
551   CASE MEBEND
552    ChannelSettings(Channel).Bend = ((ASC(INPUT$(&H1, 1)) + (ASC(INPUT$(&H1, 1)) * &H80)) - SIGN14BIT) * MIDI.BendSense
553    UpdateAllLiveNotes Channel, MOPPITCH, 0
554  END SELECT
555 ELSE
556  HandleSpecialTrackEvent Byte, Track, MIDI, Status
557 END IF
558END SUB
559
560SUB Initialize (Status AS StatusStr)
561DIM Channel
562 
563 SCREEN 0
564 WIDTH 80, 25
565 PALETTE
566 COLOR 7, 0
567 CLS
568
569 GetInstrumentData
570 OPLReset
571 OPLReset
572
573 FOR Channel = 0 TO 15
574  ChannelSettings(Channel).Volume = 127 ';;
575 NEXT Channel
576
577 Status.Began = FALSE
578 Status.LoopEnd = FALSE
579 Status.LoopStart = TRUE
580 Status.LoopWait = 0
581 Status.Paused = FALSE
582 Status.PlayWait = 0
583
584 PLAY ON
585 ON PLAY(EVENTBUFFERSIZE) GOSUB PlayerLoop
586 PLAY "ML MB"
587END SUB
588
589SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
590DIM FileName AS STRING
591DIM KeyStroke AS STRING
592
593 FileName = COMMAND$
594
595 IF FileName = "" THEN
596  PRINT "No file specified."
597 ELSE
598  OpenMIDI FileName, MIDI
599  PLAY "T255 P64 P64"
600
601  Display 1, 1, 8, "Press Q to quit; Space to pause"
602 
603  DO
604   KeyStroke = INKEY$
605
606   SELECT CASE KeyStroke
607    CASE " "
608     Status.Paused = NOT Status.Paused
609     IF Status.Paused THEN
610      PRINT "Pause"
611      PLAY STOP
612     ELSE
613      PRINT "Ok"
614      PLAY ON
615     END IF
616    CASE CHR$(3), CHR$(27), "q", "Q"
617     EXIT DO
618   END SELECT
619  LOOP
620 END IF
621END SUB
622
623SUB NoteOff (Channel)
624DIM ActiveNote
625DIM Note
626
627 Note = ASC(INPUT$(&H1, 1))
628 SEEK #1, SEEK(1) + &H1
629
630 ChannelSettings(Channel).Bend = 0
631 ActiveNote = ActRev(Channel, Note)
632 IF NOT ActiveNote = 0 THEN DeallocateActiveNote Channel, ActiveNote
633END SUB
634
635SUB NoteOn (Channel, Status AS StatusStr)
636DIM ActiveNote
637DIM AllocatedChannel
638DIM bs AS DOUBLE       '';;;What is this variable?
639DIM CandidateChannel
640DIM Instrument
641DIM Note
642DIM s AS DOUBLE        '';;;What is this variable?
643DIM Tone
644DIM Volume
645
646 '';;;;
647
648 Note = ASC(INPUT$(&H1, 1))
649 Volume = ASC(INPUT$(&H1, 1))
650 IF Volume = 0 THEN
651  'Sometimes noteoffs are optimized as 0-vol noteons
652  ActiveNote = ActRev(Channel, Note)
653  IF NOT ActiveNote = 0 THEN DeallocateActiveNote Channel, ActiveNote
654 ELSE
655  IF ActRev(Channel, Note) = 0 THEN
656   Tone = Note
657   Instrument = ChannelSettings(Channel).Patch
658   IF Channel = 9 THEN
659    Instrument = (&H80 + Note) - &H23
660    Tone = Adlib(Instrument, 11) 'Translate percussion
661   END IF
662  
663   '(MIDI channel 9 always plays percussion and ignores the patch number)
664   'Allocate AdLib channel (the physical sound channel for the note)
665   bs = -9
666   AllocatedChannel = -1
667   FOR CandidateChannel = 0 TO 17
668    s = Channels(CandidateChannel).Age
669    IF NOT Channels(CandidateChannel).IsOn THEN s = s + 3000# ' Empty channel = privileged
670    IF ChannelInstruments(CandidateChannel).Instrument = Instrument THEN s = s + .2#  ' Same instrument = good
671    IF Instrument < &H80 AND ChannelInstruments(CandidateChannel).Instrument > &H7F THEN s = (s * 2) + 9 'Percussion is inferior to melody
672    IF s > bs THEN
673     bs = s
674     AllocatedChannel = CandidateChannel
675     'Best candidate wins
676    END IF
677   NEXT CandidateChannel
678
679   IF Channels(AllocatedChannel).IsOn THEN
680    DeallocateActiveNote Channels(AllocatedChannel).MIDIChannel, Channels(AllocatedChannel).ActiveIndex
681   END IF
682
683   Channels(AllocatedChannel).IsOn = TRUE
684   ChannelInstruments(AllocatedChannel).Instrument = Instrument
685   Channels(AllocatedChannel).Age = 0
686   Status.Began = TRUE
687
688   ActiveNote = ActiveNoteCount(Channel) + 1
689   ActList(Channel, ActiveNote) = Note
690   ActRev(Channel, Note) = ActiveNote
691   ActiveNoteCount(Channel) = ActiveNote
692
693   ActTone(Channel, Note) = Tone
694   ActAdlChn(Channel, Note) = AllocatedChannel
695   ActVol(Channel, Note) = Volume
696   Channels(AllocatedChannel).MIDIChannel = Channel
697   Channels(AllocatedChannel).ActiveIndex = ActiveNote
698   OPLPatch AllocatedChannel
699   UpdateNotePan AllocatedChannel, Channel
700   UpdateNoteVolume AllocatedChannel, Channel, Volume
701  
702   Channels(AllocatedChannel).x = 1 + (Tone + &H3F) MOD &H50
703   Channels(AllocatedChannel).ColorV = 9 + (ChannelInstruments(AllocatedChannel).Instrument MOD &H6)
704
705   Display 20 - AllocatedChannel, Channels(AllocatedChannel).x, Channels(AllocatedChannel).ColorV, "#"
706
707   OPLNoteOn AllocatedChannel, 172.00093# * EXP(.057762265# * (Tone + ChannelSettings(Channel).Bend))
708   UpdateNoteVolume AllocatedChannel, Channel, Volume
709  END IF
710 END IF
711END SUB
712
713SUB NoteTouch (Channel)
714DIM ActiveChannel
715DIM Note
716DIM Volume
717
718 Note = ASC(INPUT$(&H1, 1))
719 Volume = ASC(INPUT$(&H1, 1))
720 IF NOT ActRev(Channel, Note) = 0 THEN
721  ActiveChannel = ActAdlChn(Channel, Note)
722
723  Display 20 - ActiveChannel, Channels(ActiveChannel).x, Channels(ActiveChannel).ColorV, "&"
724
725  ActVol(Channel, Note) = Volume
726  UpdateNoteVolume ActiveChannel, Channel, Volume
727 END IF
728END SUB
729
730SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
731DIM Position AS LONG
732DIM Track
733DIM TrackLength AS LONG
734
735 OPEN FileName$ FOR INPUT LOCK READ AS #1
736 CLOSE #1
737
738 OPEN FileName$ FOR BINARY LOCK READ WRITE AS #1
739  IF INPUT$(&H4, 1) = "MThd" THEN
740   IF ParseBEDWord&(INPUT$(&H4, 1)) = MTHDBLOCKDEFAULTLENGTH THEN
741    MIDI.Format = ParseBEWord(INPUT$(&H2, 1))
742    MIDI.TrackCount = ParseBEWord(INPUT$(&H2, 1))
743    REDIM Loops(0 TO MIDI.TrackCount - 1) AS TrackStr
744    REDIM LoopsBackup(0 TO MIDI.TrackCount - 1) AS TrackStr
745    REDIM Tracks(0 TO MIDI.TrackCount - 1) AS TrackStr
746    
747     '';;;
748    MIDI.InvDeltaTicks = EVENTTICKFREQUENCY / (240000000# * ParseBEWord(INPUT$(&H2, 1)))
749    MIDI.Tempo = 1000000 * MIDI.InvDeltaTicks
750    MIDI.BendSense = &H2 / &H2000
751    '';;;
752    FOR Track = 0 TO MIDI.TrackCount - 1
753     IF INPUT$(&H4, 1) = "MTrk" THEN
754      TrackLength = ParseBEDWord&(INPUT$(&H4, 1))
755      Position = LOC(1)
756      Tracks(Track).Delay = ReadVariableLengthInteger&
757      Tracks(Track).Pointer = LOC(1)
758      SEEK #1, (Position + TrackLength) + &H1
759     ELSE
760      ERROR 13
761     END IF
762    NEXT Track
763   ELSE
764    ERROR 6
765   END IF
766  ELSE
767   ERROR 13
768  END IF
769END SUB
770
771SUB OPLNoteOff (Channel)
772DIM Operator
773DIM Port
774DIM q     ''What is this variable?
775
776 Port = SetUpOPL(Channel, Operator, q)
777 OUT Port, &HB0 + q
778 OUT Port + &H1, ChannelInstruments(Channel).Pitch AND &HDF
779END SUB
780
781SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
782DIM Octave
783DIM Port
784DIM q     ''What is this variable?
785
786 Octave = GetOctave#(Hertz)
787 Port = SetUpOPL(Channel, 0, q)
788
789 OUT Port, &HA0 + q
790 OUT Port + &H1, Octave AND &HFF
791
792 Octave = Octave \ &H100
793
794 OUT Port, &HB0 + q
795 OUT Port + &H1, Octave
796
797 ChannelInstruments(Channel).Pitch = Octave
798END SUB
799
800SUB OPLPatch (Channel)
801DIM Instrument
802DIM Operator
803DIM Port
804DIM q               ''What is this variable?
805DIM x               ''What is this variable?
806
807 Port = SetUpOPL(Channel, Operator, q)
808 Instrument = ChannelInstruments(Channel).Instrument
809 q = Port + &H1
810 FOR x = &H0 TO &H1
811  OUT Port, &H20 + Operator + (x * &H3)
812  OUT q, Adlib(Instrument, &H0 + x)
813  OUT Port, &H60 + Operator + (x * &H3)
814  OUT q, Adlib(Instrument, &H4 + x)
815  OUT Port, &H80 + Operator + (x * &H3)
816  OUT q, Adlib(Instrument, &H6 + x)
817  OUT Port, &HE0 + Operator + (x * &H3)
818  OUT q, Adlib(Instrument, &H8 + x)
819 NEXT x
820END SUB
821
822SUB OPLReset ()
823DIM Operator
824DIM Port
825DIM q                ''What is this variable?
826DIM y                ''What is this variable?
827
828 Port = SetUpOPL(0, Operator, q)
829
830 FOR y = &H3 TO &H4
831  OUT Port, &H4
832  OUT Port + &H1, y * &H20
833 NEXT y
834
835 Port = SetUpOPL(9, Operator, q)
836 FOR y = &H0 TO &H2
837  OUT Port, &H5
838  OUT Port + &H1, y AND &H1
839 NEXT y
840
841 Port = SetUpOPL(0, Operator, q)
842 OUT Port, &H1
843 OUT Port + &H1, OPLENABLEWAVE
844
845 Port = SetUpOPL(0, Operator, q)
846 OUT Port, &HBD
847 OUT Port + &H1, OPLMEDOLICMODE
848
849 Port = SetUpOPL(9, Operator, q)
850 OUT Port, &H5
851 OUT Port + &H1, OPLENABLEOPL3
852
853 Port = SetUpOPL(9, Operator, q)
854 OUT Port, &H4
855 OUT Port + &H1, OPLMODE0
856
857 OPLSilence
858END SUB
859
860SUB OPLSilence ()
861DIM Channel
862
863 FOR Channel = 0 TO 17
864  OPLNoteOff Channel
865  OPLTouchReal Channel, 0
866 NEXT Channel
867END SUB
868
869SUB OPLTouchReal (Channel, Volume)
870DIM Instrument
871DIM Operator
872DIM Port
873DIM q            ''What is this variable?
874
875 Port = SetUpOPL(Channel, Operator, q)
876 Instrument = ChannelInstruments(Channel).Instrument
877
878 OUT Port, &H40 + Operator
879 q = Adlib(Instrument, 2)
880 OUT Port + &H1, (q OR &H3F) - Volume + ((q AND &H3F) * Volume) \ &H3F
881
882 OUT Port, &H43 + Operator
883 q = Adlib(Instrument, 3)
884 OUT Port + &H1, (q OR &H3F) - Volume + ((q AND &H3F) * Volume) \ &H3F
885END SUB
886
887FUNCTION ParseBEDWord& (Buffer AS STRING)
888DIM DWord AS LONG
889
890 DWord = ASC(MID$(Buffer, &H4, &H1))
891 DWord = DWord OR (ASC(MID$(Buffer, &H3, &H1)) * &H100&)
892 DWord = DWord OR (ASC(MID$(Buffer, &H2, &H1)) * &H10000)
893 ParseBEDWord& = DWord OR (ASC(MID$(Buffer, &H1, &H1)) * &H1000000)
894END FUNCTION
895
896FUNCTION ParseBEWord (Buffer AS STRING)
897DIM Word
898
899 Word = ASC(MID$(Buffer, &H2, &H1))
900 ParseBEWord = Word OR (ASC(MID$(Buffer, &H1, &H1)) * &H100)
901END FUNCTION
902
903SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
904DIM Track
905
906 FOR Track = 0 TO MIDI.TrackCount - 1
907  LoopsBackup(Track).Pointer = Tracks(Track).Pointer
908  LoopsBackup(Track).Delay = Tracks(Track).Delay
909  LoopsBackup(Track).Status = Tracks(Track).Status
910  IF Tracks(Track).Status >= 0 AND Tracks(Track).Delay <= 0 THEN
911   HandleTrackEvent Track, MIDI, Status
912   Tracks(Track).Delay = Tracks(Track).Delay + ReadVariableLengthInteger&
913   Tracks(Track).Pointer = LOC(1)
914  END IF
915 NEXT Track
916
917 IF Status.LoopStart THEN
918  SaveLoopStart MIDI, Status
919  IF ScheduleEventsAfterDelay#(GetShortestDelay&(MIDI.TrackCount), MIDI, Status) < 0 OR Status.LoopEnd THEN
920   ReturnToLoopStart MIDI, Status
921  END IF
922 END IF
923
924 DO WHILE ScheduleEventsAfterDelay#(GetShortestDelay&(MIDI.TrackCount), MIDI, Status) < 0 OR Status.LoopEnd
925  IF Status.LoopStart THEN
926   ReturnToLoopStart MIDI, Status
927  END IF
928 LOOP
929END SUB
930
931SUB Quit ()
932 PLAY OFF
933 PRINT "End!"
934 OPLSilence
935 CLOSE #1
936 COLOR 7, 0
937END SUB
938
939FUNCTION ReadVariableLengthInteger& ()
940DIM Byte
941DIM VariableLengthInteger AS LONG
942
943 VariableLengthInteger = &H0
944 DO
945  Byte = ASC(INPUT$(&H1, 1))
946  VariableLengthInteger = (VariableLengthInteger * &H80) OR (Byte AND &H7F)
947 LOOP UNTIL Byte < &H80
948
949 ReadVariableLengthInteger = VariableLengthInteger
950END FUNCTION
951
952FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
953DIM Position
954DIM Result AS STRING
955
956 Result = Text
957 FOR Position = 1 TO LEN(Text)
958  SELECT CASE MID$(Result, Position, 1)
959   CASE IS < " ", IS > "~"
960    MID$(Result, Position, 1) = "?"
961  END SELECT
962 NEXT Position
963
964 RemoveSpecialCharacters$ = Result
965END FUNCTION
966
967SUB ResetAllControllers (Channel)
968 ''Ctrl 121;;;
969 ChannelSettings(Channel).Bend = 0
970 ChannelSettings(Channel).Vibrato = 0
971 ChannelInstruments(Channel).Panning = 0
972 UpdateAllLiveNotes Channel, MOPOFF, 0
973 UpdateAllLiveNotes Channel, MOPPAN, 0
974END SUB
975
976SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
977DIM Track AS LONG
978
979 FOR Track = 0 TO MIDI.TrackCount - 1
980  Tracks(Track).Pointer = Loops(Track).Pointer
981  Tracks(Track).Delay = Loops(Track).Delay
982  Tracks(Track).Status = Loops(Track).Status
983 NEXT Track
984
985 Status.LoopEnd = FALSE
986 Status.PlayWait = Status.LoopWait
987END SUB
988
989SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
990DIM Track AS LONG
991
992 FOR Track = 0 TO MIDI.TrackCount - 1
993  Loops(Track).Pointer = LoopsBackup(Track).Pointer
994  Loops(Track).Delay = LoopsBackup(Track).Delay
995  Loops(Track).Status = LoopsBackup(Track).Status
996 NEXT Track
997
998 Status.LoopWait = Status.PlayWait
999 Status.LoopStart = FALSE
1000END SUB
1001
1002FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
1003DIM Channel
1004DIM t AS DOUBLE      '';;;;What is this variable?
1005DIM Track
1006
1007 FOR Track = 0 TO MIDI.TrackCount - 1
1008  Tracks(Track).Delay = Tracks(Track).Delay - Delay
1009 NEXT Track
1010
1011 t = Delay * MIDI.Tempo
1012 IF Status.Began THEN
1013  Status.PlayWait = Status.PlayWait + t
1014 END IF
1015
1016 FOR Channel = 0 TO 17
1017  Channels(Channel).Age = Channels(Channel).Age + t
1018 NEXT Channel
1019
1020 ScheduleEventsAfterDelay# = t
1021END FUNCTION
1022
1023FUNCTION SetUpOPL (Channel, Operator, q)
1024DIM Port
1025
1026 Port = &H0
1027 '';;;;
1028 IF Channel >= 0 AND Channel <= 17 THEN
1029  Port = OPLBASE + (&H2 * (Channel \ 9))
1030  q = Channel MOD 9
1031  Operator = (q MOD 3) + 8 * (q \ 3)
1032 END IF
1033
1034 SetUpOPL = Port
1035END FUNCTION
1036
1037SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
1038DIM ActiveChannel
1039DIM ActiveCount
1040DIM ActiveNote
1041DIM Note
1042
1043 ActiveCount = ActiveNoteCount(Channel)
1044
1045 FOR ActiveNote = 1 TO ActiveCount
1046  Note = ActList(Channel, ActiveNote)
1047  ActiveChannel = ActAdlChn(Channel, Note)
1048  SELECT CASE MIDIOperation
1049   CASE MOPOFF
1050    DeallocateActiveNote Channel, ActiveNote
1051   CASE MOPPAN
1052    UpdateNotePan ActiveChannel, Channel
1053   CASE MOPPITCH
1054    OPLNoteOn ActiveChannel, 172.00093# * EXP(.057762265# * (ActTone(Channel, Note) + ChannelSettings(Channel).Bend))
1055   CASE MOPPRESSURE
1056    ActVol(Channel, Note) = Volume
1057    UpdateNoteVolume ActiveChannel, Channel, ActVol(Channel, Note)
1058   CASE MOPVOLUME
1059    UpdateNoteVolume ActiveChannel, Channel, ActVol(Channel, Note)
1060  END SELECT
1061 NEXT ActiveNote
1062END SUB
1063
1064SUB UpdateNotePan (ActiveChannel, Channel)
1065DIM Operator
1066DIM Port
1067DIM q       '';;;What is this variable?
1068
1069 ChannelInstruments(ActiveChannel).Panning = ChannelSettings(Channel).Panning
1070 Port = SetUpOPL(ActiveChannel, Operator, q)
1071 OUT Port, &HC0 + q '';;;
1072 OUT Port + &H1, Adlib(ChannelInstruments(ActiveChannel).Instrument, 10) - ChannelInstruments(ActiveChannel).Panning
1073END SUB
1074
1075SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
1076';;;;
1077 IF Volume * ChannelSettings(Channel).Volume < 72 THEN
1078  OPLTouchReal ActiveChannel, 0
1079 ELSE
1080  OPLTouchReal ActiveChannel, LOG(Volume * ChannelSettings(Channel).Volume) * 11.541561# - 48.818955#
1081 END IF
1082END SUB

What is the challenge? Well, my program works except for the fact it tries to read beyond a MIDI file's end instead of looping back. This can be replicated in the original program by changing the following line so that it always executes RETURN instead of going to line 330 if the condition is met:

1348 IF t# < 0 OR loopEnd THEN 330 ELSE RETURN 'Loop or done

Some parts of the original GWBasic program are really hard to properly untangle.

My GitHub:
https://github.com/peterswinkels

Reply 7 of 8, by Peter Swinkels

Posted on 2022-12-13, 18:58

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

For anyone interested, I got my version of Bisqwit's MIDI player to loop:

1'$DYNAMIC
2DEFINT A-Z
3OPTION BASE 0
4OPTION EXPLICIT ''Disable for Q(uick)BASIC.
5
6CONST EVENTBUFFERSIZE = 2
7CONST EVENTTICKFREQUENCY = 16320
8CONST FALSE = 0
9CONST MEBEND = &HE0
10CONST MECONTROLLER = &HB0
11CONST MEINSTRUMENT = &HC0
12CONST MEMETA = &HFF
13CONST MENOTEOFF = &H80
14CONST MENOTEON = &H90
15CONST MEPOLYPHONIC = &HA0
16CONST MEPRESSURE = &HD0
17CONST MESONGPOSITION = &HF2
18CONST MESONGSELECT = &HF3
19CONST MESYSEXSTART = &HF0
20CONST MESYSEXEND = &HF7
21CONST MMEENDOFTRACK = &H2F
22CONST MMESETTEMPO = &H51
23CONST MMETCOPYRIGHT = &H2
24CONST MMETCUE = &H7
25CONST MMETGENERIC = &H1
26CONST MMETINSTRUMENT = &H4
27CONST MMETLYRIC = &H5
28CONST MMETMARKER = &H6
29CONST MMETTRACK = &H3
30CONST MOPOFF = 1
31CONST MOPPAN = 2
32CONST MOPPITCH = 3
33CONST MOPPRESSURE = 4
34CONST MOPVOLUME = 5
35CONST MTHDBLOCKDEFAULTLENGTH = &H6
36CONST OPLBASE = &H388
37CONST OPLENABLEOPL3 = &H1
38CONST OPLENABLEWAVE = &H20
39CONST OPLMEDOLICMODE = &H0
40CONST OPLMODE0 = &H0
41CONST SIGN14BIT = &H2000
42CONST TRUE = -1
43
44TYPE ChannelStr
45 ActiveIndex AS INTEGER
46 Age AS LONG
47 ColorV AS INTEGER
48 MIDIChannel AS INTEGER
49 IsOn AS INTEGER
50 x AS INTEGER
51 XCharacter AS INTEGER
52 XColor AS INTEGER
53END TYPE
54
55TYPE ChannelInstrumentStr
56 Instrument AS INTEGER
57 Panning AS INTEGER
58 Pitch AS INTEGER
59END TYPE
60

…Show last 1054 lines

61TYPE ChannelSettingsStr
62 Bend AS LONG
63 Volume AS INTEGER
64 Panning AS INTEGER
65 Patch AS INTEGER
66 Vibrato AS INTEGER
67END TYPE
68
69TYPE MIDIStr
70 BendSense AS DOUBLE
71 Format AS INTEGER
72 InvDeltaTicks AS DOUBLE
73 Tempo AS DOUBLE
74 TrackCount AS LONG
75END TYPE
76
77TYPE StatusStr
78 Began AS INTEGER
79 LoopEnd AS INTEGER
80 LoopStart AS INTEGER
81 LoopWait AS LONG
82 Paused AS INTEGER
83 PlayWait AS LONG
84 TextRow AS INTEGER
85END TYPE
86
87TYPE TrackStr
88 Delay AS LONG
89 Pointer AS LONG
90 Status AS INTEGER
91END TYPE
92
93DECLARE FUNCTION AllocateChannel (Instrument)
94DECLARE FUNCTION GetOctave# (Hertz AS DOUBLE)
95DECLARE FUNCTION GetShortestDelay& (TrackCount AS LONG)
96DECLARE FUNCTION ParseBEDWord& (Buffer AS STRING)
97DECLARE FUNCTION ParseBEWord (Buffer AS STRING)
98DECLARE FUNCTION ReadVariableLengthInteger& ()
99DECLARE FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
100DECLARE FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
101DECLARE FUNCTION SetUpOPL (Channel, Operator, ChannelInsidePair)
102DECLARE SUB ChangePanning (Channel, Value)
103DECLARE SUB ControllerChange (Channel, MIDI AS MIDIStr)
104DECLARE SUB DeallocateActiveNote (Channel, Note)
105DECLARE SUB Display (Row, Column, ColorV, Text AS STRING)
106DECLARE SUB DisplayNote (AllocatedChannel, Tone)
107DECLARE SUB DisplayKeys ()
108DECLARE SUB GetInstrumentData ()
109DECLARE SUB HandleSpecialTrackEvent (MIDISpecialEvent, Track, MIDI AS MIDIStr, Status AS StatusStr)
110DECLARE SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
111DECLARE SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
112DECLARE SUB Initialize (Status AS StatusStr)
113DECLARE SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
114DECLARE SUB NoteOff (Channel)
115DECLARE SUB NoteOn (Channel, Status AS StatusStr)
116DECLARE SUB NoteTouch (Channel)
117DECLARE SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
118DECLARE SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
119DECLARE SUB OPLNoteOff (Channel)
120DECLARE SUB OPLPatch (Channel)
121DECLARE SUB OPLReset ()
122DECLARE SUB OPLSilence ()
123DECLARE SUB OPLTouchReal (Channel, Volume)
124DECLARE SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
125DECLARE SUB ResetAllControllers (Channel)
126DECLARE SUB Quit ()
127DECLARE SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
128DECLARE SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
129DECLARE SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
130DECLARE SUB UpdateNotePan (ActiveChannel, Channel)
131DECLARE SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
132
133DIM MIDI AS MIDIStr
134DIM Status AS StatusStr
135
136DIM SHARED ActiveNoteCount(0 TO 15)
137DIM SHARED Adlib(0 TO 180, 0 TO 11)
138DIM SHARED Channels(0 TO 17) AS ChannelStr
139DIM SHARED ChannelInstruments(0 TO 17) AS ChannelInstrumentStr
140DIM SHARED ChannelSettings(0 TO 15) AS ChannelSettingsStr
141DIM SHARED Loops(0 TO 0) AS TrackStr
142DIM SHARED LoopsBackup(0 TO 0) AS TrackStr
143DIM SHARED Tracks(0 TO 0) AS TrackStr
144
145DIM SHARED ActTone(0 TO 15, 0 TO 127)   'orignotenumber -> simulated notenumber
146DIM SHARED ActAdlChn(0 TO 15, 0 TO 127) 'orignotenumber -> adlib channel
147DIM SHARED ActVol(0 TO 15, 0 TO 127)    'orignotenumber -> pressure
148DIM SHARED ActRev(0 TO 15, 0 TO 127)    'orignotenumber -> activeindex (index to ActList)
149DIM SHARED ActList(0 TO 15, 0 TO 99)    'activeindex -> orignotenumber (index to ActVol etc)
150
151 Initialize Status
152 CALL Main(MIDI, Status)
153 Quit
154 END
155
156PlayerLoop:
157 IF Status.Began THEN Status.PlayWait = Status.PlayWait - 1
158
159 DO WHILE Status.PlayWait = 0
160  ProcessTrackEvents MIDI, Status
161 LOOP
162 
163 DO WHILE PLAY(0) < EVENTBUFFERSIZE
164  PLAY "T255 P64"
165 LOOP
166
167 RETURN
168
169 'The data bytes are:
170 ' [0,1] AM/VIB/EG/KSR/Multiple bits for carrier and modulator respectively
171 ' [2,3] KSL/Attenuation settings    for carrier and modulator respectively
172 ' [4,5] Attack and decay rates      for carrier and modulator respectively
173 ' [6,7] Sustain and release rates   for carrier and modulator respectively
174 ' [8,9] Wave select settings        for carrier and modulator respectively
175 ' [10]  Feedback/connection bits    for the channel (also stereo/pan bits)
176 ' [11]  For percussive instruments (GP35..GP87), the tone to play
177
178Instruments:
179DATA   1,  1,143,  6,242,242,244,247,0,0, 56,  0: REM GM1:AcouGrandPiano
180DATA   1,  1, 75,  0,242,242,244,247,0,0, 56,  0: REM GM2:BrightAcouGrand
181DATA   1,  1, 73,  0,242,242,244,246,0,0, 56,  0: REM GM3:ElecGrandPiano
182DATA 129, 65, 18,  0,242,242,247,247,0,0, 54,  0: REM GM4:Honky-tonkPiano
183DATA   1,  1, 87,  0,241,242,247,247,0,0, 48,  0: REM GM5:Rhodes Piano
184DATA   1,  1,147,  0,241,242,247,247,0,0, 48,  0: REM GM6:Chorused Piano
185DATA   1, 22,128, 14,161,242,242,245,0,0, 56,  0: REM GM7:Harpsichord
186DATA   1,  1,146,  0,194,194,248,248,0,0, 58,  0: REM GM8:Clavinet
187DATA  12,129, 92,  0,246,243,244,245,0,0, 48,  0: REM GM9:Celesta
188DATA   7, 17,151,128,243,242,242,241,0,0, 50,  0: REM GM10:Glockenspiel
189DATA  23,  1, 33,  0, 84,244,244,244,0,0, 50,  0: REM GM11:Music box
190DATA 152,129, 98,  0,243,242,246,246,0,0, 48,  0: REM GM12:Vibraphone
191DATA  24,  1, 35,  0,246,231,246,247,0,0, 48,  0: REM GM13:Marimba
192DATA  21,  1,145,  0,246,246,246,246,0,0, 52,  0: REM GM14:Xylophone
193DATA  69,129, 89,128,211,163,243,243,0,0, 60,  0: REM GM15:Tubular Bells
194DATA   3,129, 73,128,117,181,245,245,1,0, 52,  0: REM GM16:Dulcimer
195DATA 113, 49,146,  0,246,241, 20,  7,0,0, 50,  0: REM GM17:Hammond Organ
196DATA 114, 48, 20,  0,199,199, 88,  8,0,0, 50,  0: REM GM18:Percussive Organ
197DATA 112,177, 68,  0,170,138, 24,  8,0,0, 52,  0: REM GM19:Rock Organ
198DATA  35,177,147,  0,151, 85, 35, 20,1,0, 52,  0: REM GM20:Church Organ
199DATA  97,177, 19,128,151, 85,  4,  4,1,0, 48,  0: REM GM21:Reed Organ
200DATA  36,177, 72,  0,152, 70, 42, 26,1,0, 60,  0: REM GM22:Accordion
201DATA  97, 33, 19,  0,145, 97,  6,  7,1,0, 58,  0: REM GM23:Harmonica
202DATA  33,161, 19,137,113, 97,  6,  7,0,0, 54,  0: REM GM24:Tango Accordion
203DATA   2, 65,156,128,243,243,148,200,1,0, 60,  0: REM GM25:Acoustic Guitar1
204DATA   3, 17, 84,  0,243,241,154,231,1,0, 60,  0: REM GM26:Acoustic Guitar2
205DATA  35, 33, 95,  0,241,242, 58,248,0,0, 48,  0: REM GM27:Electric Guitar1
206DATA   3, 33,135,128,246,243, 34,248,1,0, 54,  0: REM GM28:Electric Guitar2
207DATA   3, 33, 71,  0,249,246, 84, 58,0,0, 48,  0: REM GM29:Electric Guitar3
208DATA  35, 33, 74,  5,145,132, 65, 25,1,0, 56,  0: REM GM30:Overdrive Guitar
209DATA  35, 33, 74,  0,149,148, 25, 25,1,0, 56,  0: REM GM31:Distorton Guitar
210DATA   9,132,161,128, 32,209, 79,248,0,0, 56,  0: REM GM32:Guitar Harmonics
211DATA  33,162, 30,  0,148,195,  6,166,0,0, 50,  0: REM GM33:Acoustic Bass
212DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM34:Electric Bass 1
213DATA  49, 49,141,  0,241,241,232,120,0,0, 58,  0: REM GM35:Electric Bass 2
214DATA  49, 50, 91,  0, 81,113, 40, 72,0,0, 60,  0: REM GM36:Fretless Bass
215DATA   1, 33,139, 64,161,242,154,223,0,0, 56,  0: REM GM37:Slap Bass 1
216DATA  33, 33,139,  8,162,161, 22,223,0,0, 56,  0: REM GM38:Slap Bass 2
217DATA  49, 49,139,  0,244,241,232,120,0,0, 58,  0: REM GM39:Synth Bass 1
218DATA  49, 49, 18,  0,241,241, 40, 24,0,0, 58,  0: REM GM40:Synth Bass 2
219DATA  49, 33, 21,  0,221, 86, 19, 38,1,0, 56,  0: REM GM41:Violin
220DATA  49, 33, 22,  0,221,102, 19,  6,1,0, 56,  0: REM GM42:Viola
221DATA 113, 49, 73,  0,209, 97, 28, 12,1,0, 56,  0: REM GM43:Cello
222DATA  33, 35, 77,128,113,114, 18,  6,1,0, 50,  0: REM GM44:Contrabass
223DATA 241,225, 64,  0,241,111, 33, 22,1,0, 50,  0: REM GM45:Tremulo Strings
224DATA   2,  1, 26,128,245,133,117, 53,1,0, 48,  0: REM GM46:Pizzicato String
225DATA   2,  1, 29,128,245,243,117,244,1,0, 48,  0: REM GM47:Orchestral Harp
226DATA  16, 17, 65,  0,245,242,  5,195,1,0, 50,  0: REM GM48:Timpany
227DATA  33,162,155,  1,177,114, 37,  8,1,0, 62,  0: REM GM49:String Ensemble1
228DATA 161, 33,152,  0,127, 63,  3,  7,1,1, 48,  0: REM GM50:String Ensemble2
229DATA 161, 97,147,  0,193, 79, 18,  5,0,0, 58,  0: REM GM51:Synth Strings 1
230DATA  33, 97, 24,  0,193, 79, 34,  5,0,0, 60,  0: REM GM52:SynthStrings 2
231DATA  49,114, 91,131,244,138, 21,  5,0,0, 48,  0: REM GM53:Choir Aahs
232DATA 161, 97,144,  0,116,113, 57,103,0,0, 48,  0: REM GM54:Voice Oohs
233DATA 113,114, 87,  0, 84,122,  5,  5,0,0, 60,  0: REM GM55:Synth Voice
234DATA 144, 65,  0,  0, 84,165, 99, 69,0,0, 56,  0: REM GM56:Orchestra Hit
235DATA  33, 33,146,  1,133,143, 23,  9,0,0, 60,  0: REM GM57:Trumpet
236DATA  33, 33,148,  5,117,143, 23,  9,0,0, 60,  0: REM GM58:Trombone
237DATA  33, 97,148,  0,118,130, 21, 55,0,0, 60,  0: REM GM59:Tuba
238DATA  49, 33, 67,  0,158, 98, 23, 44,1,1, 50,  0: REM GM60:Muted Trumpet
239DATA  33, 33,155,  0, 97,127,106, 10,0,0, 50,  0: REM GM61:French Horn
240DATA  97, 34,138,  6,117,116, 31, 15,0,0, 56,  0: REM GM62:Brass Section
241DATA 161, 33,134,131,114,113, 85, 24,1,0, 48,  0: REM GM63:Synth Brass 1
242DATA  33, 33, 77,  0, 84,166, 60, 28,0,0, 56,  0: REM GM64:Synth Brass 2
243DATA  49, 97,143,  0,147,114,  2, 11,1,0, 56,  0: REM GM65:Soprano Sax
244DATA  49, 97,142,  0,147,114,  3,  9,1,0, 56,  0: REM GM66:Alto Sax
245DATA  49, 97,145,  0,147,130,  3,  9,1,0, 58,  0: REM GM67:Tenor Sax
246DATA  49, 97,142,  0,147,114, 15, 15,1,0, 58,  0: REM GM68:Baritone Sax
247DATA  33, 33, 75,  0,170,143, 22, 10,1,0, 56,  0: REM GM69:Oboe
248DATA  49, 33,144,  0,126,139, 23, 12,1,1, 54,  0: REM GM70:English Horn
249DATA  49, 50,129,  0,117, 97, 25, 25,1,0, 48,  0: REM GM71:Bassoon
250DATA  50, 33,144,  0,155,114, 33, 23,0,0, 52,  0: REM GM72:Clarinet
251DATA 225,225, 31,  0,133,101, 95, 26,0,0, 48,  0: REM GM73:Piccolo
252DATA 225,225, 70,  0,136,101, 95, 26,0,0, 48,  0: REM GM74:Flute
253DATA 161, 33,156,  0,117,117, 31, 10,0,0, 50,  0: REM GM75:Recorder
254DATA  49, 33,139,  0,132,101, 88, 26,0,0, 48,  0: REM GM76:Pan Flute
255DATA 225,161, 76,  0,102,101, 86, 38,0,0, 48,  0: REM GM77:Bottle Blow
256DATA  98,161,203,  0,118, 85, 70, 54,0,0, 48,  0: REM GM78:Shakuhachi
257DATA  98,161,153,  0, 87, 86,  7,  7,0,0, 59,  0: REM GM79:Whistle
258DATA  98,161,147,  0,119,118,  7,  7,0,0, 59,  0: REM GM80:Ocarina
259DATA  34, 33, 89,  0,255,255,  3, 15,2,0, 48,  0: REM GM81:Lead 1 squareea
260DATA  33, 33, 14,  0,255,255, 15, 15,1,1, 48,  0: REM GM82:Lead 2 sawtooth
261DATA  34, 33, 70,128,134,100, 85, 24,0,0, 48,  0: REM GM83:Lead 3 calliope
262DATA  33,161, 69,  0,102,150, 18, 10,0,0, 48,  0: REM GM84:Lead 4 chiff
263DATA  33, 34,139,  0,146,145, 42, 42,1,0, 48,  0: REM GM85:Lead 5 charang
264DATA 162, 97,158, 64,223,111,  5,  7,0,0, 50,  0: REM GM86:Lead 6 voice
265DATA  32, 96, 26,  0,239,143,  1,  6,0,2, 48,  0: REM GM87:Lead 7 fifths
266DATA  33, 33,143,128,241,244, 41,  9,0,0, 58,  0: REM GM88:Lead 8 brass
267DATA 119,161,165,  0, 83,160,148,  5,0,0, 50,  0: REM GM89:Pad 1 new age
268DATA  97,177, 31,128,168, 37, 17,  3,0,0, 58,  0: REM GM90:Pad 2 warm
269DATA  97, 97, 23,  0,145, 85, 52, 22,0,0, 60,  0: REM GM91:Pad 3 polysynth
270DATA 113,114, 93,  0, 84,106,  1,  3,0,0, 48,  0: REM GM92:Pad 4 choir
271DATA  33,162,151,  0, 33, 66, 67, 53,0,0, 56,  0: REM GM93:Pad 5 bowedpad
272DATA 161, 33, 28,  0,161, 49,119, 71,1,1, 48,  0: REM GM94:Pad 6 metallic
273DATA  33, 97,137,  3, 17, 66, 51, 37,0,0, 58,  0: REM GM95:Pad 7 halo
274DATA 161, 33, 21,  0, 17,207, 71,  7,1,0, 48,  0: REM GM96:Pad 8 sweep
275DATA  58, 81,206,  0,248,134,246,  2,0,0, 50,  0: REM GM97:FX 1 rain
276DATA  33, 33, 21,  0, 33, 65, 35, 19,1,0, 48,  0: REM GM98:FX 2 soundtrack
277DATA   6,  1, 91,  0,116,165,149,114,0,0, 48,  0: REM GM99:FX 3 crystal
278DATA  34, 97,146,131,177,242,129, 38,0,0, 60,  0: REM GM100:FX 4 atmosphere
279DATA  65, 66, 77,  0,241,242, 81,245,1,0, 48,  0: REM GM101:FX 5 brightness
280DATA  97,163,148,128, 17, 17, 81, 19,1,0, 54,  0: REM GM102:FX 6 goblins
281DATA  97,161,140,128, 17, 29, 49,  3,0,0, 54,  0: REM GM103:FX 7 echoes
282DATA 164, 97, 76,  0,243,129,115, 35,1,0, 52,  0: REM GM104:FX 8 sci-fi
283DATA   2,  7,133,  3,210,242, 83,246,0,1, 48,  0: REM GM105:Sitar
284DATA  17, 19, 12,128,163,162, 17,229,1,0, 48,  0: REM GM106:Banjo
285DATA  17, 17,  6,  0,246,242, 65,230,1,2, 52,  0: REM GM107:Shamisen
286DATA 147,145,145,  0,212,235, 50, 17,0,1, 56,  0: REM GM108:Koto
287DATA   4,  1, 79,  0,250,194, 86,  5,0,0, 60,  0: REM GM109:Kalimba
288DATA  33, 34, 73,  0,124,111, 32, 12,0,1, 54,  0: REM GM110:Bagpipe
289DATA  49, 33,133,  0,221, 86, 51, 22,1,0, 58,  0: REM GM111:Fiddle
290DATA  32, 33,  4,129,218,143,  5, 11,2,0, 54,  0: REM GM112:Shanai
291DATA   5,  3,106,128,241,195,229,229,0,0, 54,  0: REM GM113:Tinkle Bell
292DATA   7,  2, 21,  0,236,248, 38, 22,0,0, 58,  0: REM GM114:Agogo Bells
293DATA   5,  1,157,  0,103,223, 53,  5,0,0, 56,  0: REM GM115:Steel Drums
294DATA  24, 18,150,  0,250,248, 40,229,0,0, 58,  0: REM GM116:Woodblock
295DATA  16,  0,134,  3,168,250,  7,  3,0,0, 54,  0: REM GM117:Taiko Drum
296DATA  17, 16, 65,  3,248,243, 71,  3,2,0, 52,  0: REM GM118:Melodic Tom
297DATA   1, 16,142,  0,241,243,  6,  2,2,0, 62,  0: REM GM119:Synth Drum
298DATA  14,192,  0,  0, 31, 31,  0,255,0,3, 62,  0: REM GM120:Reverse Cymbal
299DATA   6,  3,128,136,248, 86, 36,132,0,2, 62,  0: REM GM121:Guitar FretNoise
300DATA  14,208,  0,  5,248, 52,  0,  4,0,3, 62,  0: REM GM122:Breath Noise
301DATA  14,192,  0,  0,246, 31,  0,  2,0,3, 62,  0: REM GM123:Seashore
302DATA 213,218,149, 64, 55, 86,163, 55,0,0, 48,  0: REM GM124:Bird Tweet
303DATA  53, 20, 92,  8,178,244, 97, 21,2,0, 58,  0: REM GM125:Telephone
304DATA  14,208,  0,  0,246, 79,  0,245,0,3, 62,  0: REM GM126:Helicopter
305DATA  38,228,  0,  0,255, 18,  1, 22,0,1, 62,  0: REM GM127:Applause/Noise
306DATA   0,  0,  0,  0,243,246,240,201,0,2, 62,  0: REM GM128:Gunshot
307DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP35:Ac Bass Drum
308DATA  16, 17, 68,  0,248,243,119,  6,2,0, 56, 35: REM GP36:Bass Drum 1
309DATA   2, 17,  7,  0,249,248,255,255,0,0, 56, 52: REM GP37:Side Stick
310DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 48: REM GP38:Acoustic Snare
311DATA   0,  1,  2,  0,255,255,  7,  8,0,0, 48, 58: REM GP39:Hand Clap
312DATA   0,  0,  0,  0,252,250,  5, 23,2,0, 62, 60: REM GP40:Electric Snare
313DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 47: REM GP41:Low Floor Tom
314DATA  12, 18,  0,  0,246,251,  8, 71,0,2, 58, 43: REM GP42:Closed High Hat
315DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 49: REM GP43:High Floor Tom
316DATA  12, 18,  0,  5,246,123,  8, 71,0,2, 58, 43: REM GP44:Pedal High Hat
317DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 51: REM GP45:Low Tom
318DATA  12, 18,  0,  0,246,203,  2, 67,0,2, 58, 43: REM GP46:Open High Hat
319DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 54: REM GP47:Low-Mid Tom
320DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 57: REM GP48:High-Mid Tom
321DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 72: REM GP49:Crash Cymbal 1
322DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 60: REM GP50:High Tom
323DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 76: REM GP51:Ride Cymbal 1
324DATA  14,208,  0, 10,245,159, 48,  2,0,0, 62, 84: REM GP52:Chinese Cymbal
325DATA  14,  7, 10, 93,228,245,228,229,3,1, 54, 36: REM GP53:Ride Bell
326DATA   2,  5,  3, 10,180,151,  4,247,0,0, 62, 65: REM GP54:Tambourine
327DATA  78,158,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP55:Splash Cymbal
328DATA  17, 16, 69,  8,248,243, 55,  5,2,0, 56, 83: REM GP56:Cow Bell
329DATA  14,208,  0,  0,246,159,  0,  2,0,3, 62, 84: REM GP57:Crash Cymbal 2
330DATA 128, 16,  0, 13,255,255,  3, 20,3,0, 60, 24: REM GP58:Vibraslap
331DATA  14,  7,  8, 74,248,244, 66,228,0,3, 62, 77: REM GP59:Ride Cymbal 2
332DATA   6,  2, 11,  0,245,245, 12,  8,0,0, 54, 60: REM GP60:High Bongo
333DATA   1,  2,  0,  0,250,200,191,151,0,0, 55, 65: REM GP61:Low Bongo
334DATA   1,  1, 81,  0,250,250,135,183,0,0, 54, 59: REM GP62:Mute High Conga
335DATA   1,  2, 84,  0,250,248,141,184,0,0, 54, 51: REM GP63:Open High Conga
336DATA   1,  2, 89,  0,250,248,136,182,0,0, 54, 45: REM GP64:Low Conga
337DATA   1,  0,  0,  0,249,250, 10,  6,3,0, 62, 71: REM GP65:High Timbale
338DATA   0,  0,128,  0,249,246,137,108,3,0, 62, 60: REM GP66:Low Timbale
339DATA   3, 12,128,  8,248,246,136,182,3,0, 63, 58: REM GP67:High Agogo
340DATA   3, 12,133,  0,248,246,136,182,3,0, 63, 53: REM GP68:Low Agogo
341DATA  14,  0, 64,  8,118,119, 79, 24,0,2, 62, 64: REM GP69:Cabasa
342DATA  14,  3, 64,  0,200,155, 73,105,0,2, 62, 71: REM GP70:Maracas
343DATA 215,199,220,  0,173,141,  5,  5,3,0, 62, 61: REM GP71:Short Whistle
344DATA 215,199,220,  0,168,136,  4,  4,3,0, 62, 61: REM GP72:Long Whistle
345DATA 128, 17,  0,  0,246,103,  6, 23,3,3, 62, 44: REM GP73:Short Guiro
346DATA 128, 17,  0,  9,245, 70,  5, 22,2,3, 62, 40: REM GP74:Long Guiro
347DATA   6, 21, 63,  0,  0,247,244,245,0,0, 49, 69: REM GP75:Claves
348DATA   6, 18, 63,  0,  0,247,244,245,3,0, 48, 68: REM GP76:High Wood Block
349DATA   6, 18, 63,  0,  0,247,244,245,0,0, 49, 63: REM GP77:Low Wood Block
350DATA   1,  2, 88,  0,103,117,231,  7,0,0, 48, 74: REM GP78:Mute Cuica
351DATA  65, 66, 69,  8,248,117, 72,  5,0,0, 48, 60: REM GP79:Open Cuica
352DATA  10, 30, 64, 78,224,255,240,  5,3,0, 56, 80: REM GP80:Mute Triangle
353DATA  10, 30,124, 82,224,255,240,  2,3,0, 56, 64: REM GP81:Open Triangle
354DATA  14,  0, 64,  8,122,123, 74, 27,0,2, 62, 72: REM GP82
355DATA  14,  7, 10, 64,228, 85,228, 57,3,1, 54, 73: REM GP83
356DATA   5,  4,  5, 64,249,214, 50,165,3,0, 62, 70: REM GP84
357DATA   2, 21, 63,  0,  0,247,243,245,3,0, 56, 68: REM GP85
358DATA   1,  2, 79,  0,250,248,141,181,0,0, 55, 48: REM GP86
359DATA   0,  0,  0,  0,246,246, 12,  6,0,0, 52, 53: REM GP87
360
361REM $STATIC
362FUNCTION AllocateChannel (Instrument)
363DIM AllocatedChannel
364DIM CandidateChannel
365DIM bs AS DOUBLE   ''???
366DIM s AS DOUBLE    ''
367                     
368 AllocatedChannel = -1
369 bs = -9
370 FOR CandidateChannel = 0 TO 17
371  s = Channels(CandidateChannel).Age
372
373  IF NOT Channels(CandidateChannel).IsOn THEN
374   s = s + 3000
375  END IF
376
377  IF ChannelInstruments(CandidateChannel).Instrument = Instrument THEN
378   s = s + .2
379  END IF
380
381  IF Instrument < &H80 AND ChannelInstruments(CandidateChannel).Instrument > &H7F THEN
382   s = (s * 2) + 9
383  END IF
384
385  IF s > bs THEN
386   bs = s
387   AllocatedChannel = CandidateChannel
388  END IF
389 NEXT CandidateChannel
390
391 AllocateChannel = AllocatedChannel
392END FUNCTION
393
394SUB ChangePanning (Channel, Value)
395DIM Panning
396
397 Panning = &H0
398 IF Value < &H30 THEN
399  Panning = &H20
400 ELSEIF Value > &H4F THEN
401  Panning = &H10
402 END IF
403
404 ChannelSettings(Channel).Panning = Panning
405END SUB
406
407SUB ControllerChange (Channel, MIDI AS MIDIStr)
408DIM Controller
409DIM Value
410
411 Controller = ASC(INPUT$(&H1, 1))
412 Value = ASC(INPUT$(&H1, 1))
413
414 SELECT CASE Controller
415  CASE &H1
416   ChannelSettings(Channel).Vibrato = Value
417  CASE &H6
418   MIDI.BendSense = Value / &H2000
419  CASE &H7
420   ChannelSettings(Channel).Volume = Value
421   UpdateAllLiveNotes Channel, MOPPAN, 0
422  CASE &HA
423   ChangePanning Channel, Value
424   UpdateAllLiveNotes Channel, MOPPAN, 0
425  CASE &H79
426   ResetAllControllers Channel
427   UpdateAllLiveNotes Channel, MOPPAN, 0
428  CASE &H7B
429   UpdateAllLiveNotes Channel, MOPVOLUME, 0
430 END SELECT
431END SUB
432
433SUB DeallocateActiveNote (Channel, Note)
434DIM ActiveNoteCount
435DIM DeactivatedNoteChannel
436DIM NoteToDeactivate
437
438 ActiveNoteCount = ActiveNoteCount(Channel)
439 NoteToDeactivate = ActList(Channel, Note)
440 ActRev(Channel, NoteToDeactivate) = 0
441 ActiveNoteCount(Channel) = ActiveNoteCount - 1
442 DeactivatedNoteChannel = ActAdlChn(Channel, NoteToDeactivate)
443 Channels(DeactivatedNoteChannel).IsOn = FALSE
444 Channels(DeactivatedNoteChannel).Age = 0
445 OPLNoteOff DeactivatedNoteChannel
446
447 IF Channels(DeactivatedNoteChannel).XCharacter = 32 THEN
448  Display 20 - DeactivatedNoteChannel, Channels(DeactivatedNoteChannel).x, 1, "."
449 ELSE
450  Display 20 - DeactivatedNoteChannel, Channels(DeactivatedNoteChannel).x, Channels(DeactivatedNoteChannel).XColor, CHR$(Channels(DeactivatedNoteChannel).XCharacter)
451 END IF
452
453 IF NOT Note = ActiveNoteCount THEN
454  NoteToDeactivate = ActList(Channel, ActiveNoteCount)
455  ActList(Channel, Note) = NoteToDeactivate
456  ActRev(Channel, NoteToDeactivate) = Note
457  Channels(ActAdlChn(Channel, NoteToDeactivate)).ActiveIndex = Note
458 END IF
459END SUB
460
461SUB Display (Row, Column, ColorV, Text AS STRING)
462 COLOR ColorV
463 LOCATE Row, Column
464 PRINT Text;
465END SUB
466
467SUB DisplayKeys ()
468 Display 1, 1, 8, "Press Q to quit; Space to pause"
469END SUB
470
471SUB DisplayNote (AllocatedChannel, Tone)
472DIM x
473DIM y
474
475 Channels(AllocatedChannel).x = 1 + (Tone + &H3F) MOD &H50
476 Channels(AllocatedChannel).ColorV = 9 + (ChannelInstruments(AllocatedChannel).Instrument MOD &H6)
477 y = 20 - AllocatedChannel
478 x = Channels(AllocatedChannel).x
479 Channels(AllocatedChannel).XCharacter = SCREEN(y, x, FALSE)
480 Channels(AllocatedChannel).XColor = SCREEN(y, x, TRUE)
481 Display y, x, Channels(AllocatedChannel).ColorV, "#"
482END SUB
483
484SUB GetInstrumentData ()
485DIM Column
486DIM Instrument
487
488 RESTORE Instruments
489 FOR Instrument = LBOUND(Adlib, 1) TO UBOUND(Adlib, 1)
490  FOR Column = LBOUND(Adlib, 2) TO UBOUND(Adlib, 2)
491   READ Adlib(Instrument, Column)
492  NEXT Column
493 NEXT Instrument
494END SUB
495
496FUNCTION GetOctave# (Hertz AS DOUBLE)
497DIM Octave AS DOUBLE
498
499 Octave = &H2000
500 DO WHILE Hertz >= 1023.5
501  Hertz = Hertz / 2
502  Octave = Octave + &H400
503 LOOP
504
505 GetOctave# = Octave + CINT(Hertz)
506END FUNCTION
507
508FUNCTION GetShortestDelay& (TrackCount AS LONG)
509DIM ShortestDelay AS LONG
510DIM Track
511
512 ShortestDelay = -1
513 FOR Track = 0 TO TrackCount - 1
514  IF Tracks(Track).Status >= 0 THEN
515   IF ShortestDelay = -1 OR Tracks(Track).Delay < ShortestDelay THEN
516    ShortestDelay = Tracks(Track).Delay
517   END IF
518  END IF
519 NEXT Track
520
521 GetShortestDelay& = ShortestDelay
522END FUNCTION
523
524SUB HandleSpecialTrackEvent (MIDISpecialEvent, Track, MIDI AS MIDIStr, Status AS StatusStr)
525DIM Ignored AS LONG
526DIM StringV AS STRING
527
528 SELECT CASE MIDISpecialEvent
529  CASE MESONGPOSITION
530   SEEK #1, SEEK(1) + &H2
531  CASE MESONGSELECT
532   SEEK #1, SEEK(1) + &H1
533  CASE MESYSEXSTART, MESYSEXEND
534   Ignored = ReadVariableLengthInteger&
535  CASE ELSE
536   HandleSpecialTrackMetaEvent Track, MIDI, Status
537 END SELECT
538END SUB
539
540SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
541DIM EventType
542DIM StringV AS STRING
543
544 EventType = ASC(INPUT$(&H1, 1))
545 StringV = INPUT$(ReadVariableLengthInteger&, 1)
546
547 SELECT CASE EventType
548  CASE MMETMARKER
549   IF StringV = "loopStart" THEN
550    Status.LoopStart = TRUE
551   ELSEIF StringV = "loopEnd" THEN
552    Status.LoopEnd = TRUE
553   END IF
554  CASE MMEENDOFTRACK
555   Tracks(Track).Status = -1 ';;;
556   Status.LoopEnd = TRUE
557  CASE MMESETTEMPO
558   MIDI.Tempo = ParseBEDWord&(CHR$(&H0) + StringV) * MIDI.InvDeltaTicks
559  CASE MMETCOPYRIGHT, MMETGENERIC, MMETINSTRUMENT, MMETLYRIC, MMETMARKER, MMETTRACK
560   Status.TextRow = 3 + (Status.TextRow - 2) MOD 20
561   Display Status.TextRow, 1, 8, "Meta" + STR$(EventType) + ": " + RemoveSpecialCharacters$(StringV)
562 END SELECT
563END SUB
564
565SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
566DIM Byte
567DIM Channel
568
569 SEEK #1, Tracks(Track).Pointer + &H1
570 Byte = ASC(INPUT$(&H1, 1))
571
572 IF Byte < MESYSEXSTART THEN
573  IF Byte < &H80 THEN
574   Byte = Tracks(Track).Status OR &H80
575   SEEK #1, Tracks(Track).Pointer
576   SEEK #1, SEEK(1) + &H1
577  END IF
578
579  Channel = Byte AND &HF
580  Tracks(Track).Status = Byte
581  SELECT CASE Byte AND &HF0
582   CASE MENOTEOFF
583    NoteOff Channel
584   CASE MENOTEON
585    NoteOn Channel, Status
586   CASE MEPOLYPHONIC
587    NoteTouch Channel
588   CASE MECONTROLLER
589    ControllerChange Channel, MIDI
590   CASE MEINSTRUMENT
591    ChannelSettings(Channel).Patch = ASC(INPUT$(&H1, 1))
592   CASE MEPRESSURE
593    UpdateAllLiveNotes Channel, MOPPRESSURE, ASC(INPUT$(&H1, 1))
594   CASE MEBEND
595    ChannelSettings(Channel).Bend = ((ASC(INPUT$(&H1, 1)) + (ASC(INPUT$(&H1, 1)) * &H80)) - SIGN14BIT) * MIDI.BendSense
596    UpdateAllLiveNotes Channel, MOPPITCH, 0
597  END SELECT
598 ELSE
599  HandleSpecialTrackEvent Byte, Track, MIDI, Status
600 END IF
601END SUB
602
603SUB Initialize (Status AS StatusStr)
604DIM Channel
605 
606 SCREEN 0
607 WIDTH 80, 25
608 PALETTE
609 COLOR 7, 0
610 CLS
611
612 GetInstrumentData
613 OPLReset
614 OPLReset
615
616 FOR Channel = 0 TO 15
617  ChannelSettings(Channel).Volume = 127 ';;
618 NEXT Channel
619
620 Status.Began = FALSE
621 Status.LoopEnd = FALSE
622 Status.LoopStart = TRUE
623 Status.LoopWait = 0
624 Status.Paused = FALSE
625 Status.PlayWait = 0
626 Status.TextRow = 2
627
628 PLAY ON
629 ON PLAY(EVENTBUFFERSIZE) GOSUB PlayerLoop
630 PLAY "ML MB"
631END SUB
632
633SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
634DIM FileName AS STRING
635DIM KeyStroke AS STRING
636
637 FileName = COMMAND$
638
639 IF FileName = "" THEN
640  PRINT "No file specified."
641 ELSE
642  OpenMIDI FileName, MIDI
643  PLAY "T255 P64 P64"
644
645  DisplayKeys
646
647  DO
648   KeyStroke = INKEY$
649
650   SELECT CASE KeyStroke
651    CASE " "
652     Status.Paused = NOT Status.Paused
653     IF Status.Paused THEN
654      PRINT "Pause"
655      PLAY STOP
656     ELSE
657      PRINT "Ok"
658      PLAY ON
659     END IF
660    CASE "q", "Q"
661     EXIT DO
662   END SELECT
663  LOOP
664 END IF
665END SUB
666
667SUB NoteOff (Channel)
668DIM ActiveNote
669DIM Note
670
671 Note = ASC(INPUT$(&H1, 1))
672 SEEK #1, SEEK(1) + &H1
673
674 ChannelSettings(Channel).Bend = 0
675 ActiveNote = ActRev(Channel, Note)
676 IF NOT ActiveNote = 0 THEN DeallocateActiveNote Channel, ActiveNote
677END SUB
678
679SUB NoteOn (Channel, Status AS StatusStr)
680DIM ActiveNote
681DIM AllocatedChannel
682DIM Instrument
683DIM Note
684DIM Tone
685DIM Volume
686
687 Note = ASC(INPUT$(&H1, 1))
688 Volume = ASC(INPUT$(&H1, 1))
689
690 IF Volume = 0 THEN
691  ActiveNote = ActRev(Channel, Note)
692  IF NOT ActiveNote = 0 THEN
693   DeallocateActiveNote Channel, ActiveNote
694  END IF
695 ELSE
696  IF ActRev(Channel, Note) = 0 THEN
697   Tone = Note
698   Instrument = ChannelSettings(Channel).Patch
699   IF Channel = 9 THEN
700    Instrument = (&H80 + Note) - &H23
701    Tone = Adlib(Instrument, 11)
702   END IF
703  
704   AllocatedChannel = AllocateChannel(Instrument)
705
706   IF Channels(AllocatedChannel).IsOn THEN
707    DeallocateActiveNote Channels(AllocatedChannel).MIDIChannel, Channels(AllocatedChannel).ActiveIndex
708   END IF
709
710   Channels(AllocatedChannel).IsOn = TRUE
711   ChannelInstruments(AllocatedChannel).Instrument = Instrument
712   Channels(AllocatedChannel).Age = 0
713   Status.Began = TRUE
714
715   ActiveNote = ActiveNoteCount(Channel) + 1
716   ActList(Channel, ActiveNote) = Note
717   ActRev(Channel, Note) = ActiveNote
718   ActiveNoteCount(Channel) = ActiveNote
719
720   ActTone(Channel, Note) = Tone
721   ActAdlChn(Channel, Note) = AllocatedChannel
722   ActVol(Channel, Note) = Volume
723   Channels(AllocatedChannel).MIDIChannel = Channel
724   Channels(AllocatedChannel).ActiveIndex = ActiveNote
725   OPLPatch AllocatedChannel
726   UpdateNotePan AllocatedChannel, Channel
727   UpdateNoteVolume AllocatedChannel, Channel, Volume
728  
729   DisplayNote AllocatedChannel, Tone
730  
731   OPLNoteOn AllocatedChannel, 172.00093# * EXP(.057762265# * (Tone + ChannelSettings(Channel).Bend))
732   UpdateNoteVolume AllocatedChannel, Channel, Volume
733  END IF
734 END IF
735END SUB
736
737SUB NoteTouch (Channel)
738DIM ActiveChannel
739DIM Note
740DIM Volume
741
742 Note = ASC(INPUT$(&H1, 1))
743 Volume = ASC(INPUT$(&H1, 1))
744 IF NOT ActRev(Channel, Note) = 0 THEN
745  ActiveChannel = ActAdlChn(Channel, Note)
746  Display 20 - ActiveChannel, Channels(ActiveChannel).x, Channels(ActiveChannel).ColorV, "&"
747  ActVol(Channel, Note) = Volume
748  UpdateNoteVolume ActiveChannel, Channel, Volume
749 END IF
750END SUB
751
752SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
753DIM Position AS LONG
754DIM Track
755DIM TrackLength AS LONG
756
757 OPEN FileName$ FOR INPUT LOCK READ AS #1
758 CLOSE #1
759
760 OPEN FileName$ FOR BINARY LOCK READ WRITE AS #1
761  IF INPUT$(&H4, 1) = "MThd" THEN
762   IF ParseBEDWord&(INPUT$(&H4, 1)) = MTHDBLOCKDEFAULTLENGTH THEN
763    MIDI.Format = ParseBEWord(INPUT$(&H2, 1))
764    MIDI.TrackCount = ParseBEWord(INPUT$(&H2, 1))
765
766    REDIM Loops(0 TO MIDI.TrackCount - 1) AS TrackStr
767    REDIM LoopsBackup(0 TO MIDI.TrackCount - 1) AS TrackStr
768    REDIM Tracks(0 TO MIDI.TrackCount - 1) AS TrackStr
769    
770    MIDI.InvDeltaTicks = EVENTTICKFREQUENCY / (240000000# * ParseBEWord(INPUT$(&H2, 1)))
771    MIDI.Tempo = 1000000 * MIDI.InvDeltaTicks
772    MIDI.BendSense = &H2 / &H2000
773
774    FOR Track = 0 TO MIDI.TrackCount - 1
775     IF INPUT$(&H4, 1) = "MTrk" THEN
776      TrackLength = ParseBEDWord&(INPUT$(&H4, 1))
777      Position = LOC(1)
778      Tracks(Track).Delay = ReadVariableLengthInteger&
779      Tracks(Track).Pointer = LOC(1)
780      SEEK #1, (Position + TrackLength) + &H1
781     ELSE
782      ERROR 13
783     END IF
784    NEXT Track
785   ELSE
786    ERROR 6
787   END IF
788  ELSE
789   ERROR 13
790  END IF
791END SUB
792
793SUB OPLNoteOff (Channel)
794DIM ChannelInsidePair
795DIM Operator
796DIM Port
797
798 Port = SetUpOPL(Channel, Operator, ChannelInsidePair)
799 OUT Port, &HB0 + ChannelInsidePair
800 OUT Port + &H1, ChannelInstruments(Channel).Pitch AND &HDF
801END SUB
802
803SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
804DIM ChannelInsidePair
805DIM Octave
806DIM Port
807
808 Octave = GetOctave#(Hertz)
809 Port = SetUpOPL(Channel, 0, ChannelInsidePair)
810
811 OUT Port, &HA0 + ChannelInsidePair
812 OUT Port + &H1, Octave AND &HFF
813
814 Octave = Octave \ &H100
815
816 OUT Port, &HB0 + ChannelInsidePair
817 OUT Port + &H1, Octave
818
819 ChannelInstruments(Channel).Pitch = Octave
820END SUB
821
822SUB OPLPatch (Channel)
823DIM ChannelInsidePair
824DIM Instrument
825DIM Operator
826DIM Port
827DIM x               ''What is this variable?
828
829 Port = SetUpOPL(Channel, Operator, ChannelInsidePair)
830 Instrument = ChannelInstruments(Channel).Instrument
831 ChannelInsidePair = Port + &H1
832 FOR x = &H0 TO &H1
833  OUT Port, &H20 + Operator + (x * &H3)
834  OUT ChannelInsidePair, Adlib(Instrument, &H0 + x)
835  OUT Port, &H60 + Operator + (x * &H3)
836  OUT ChannelInsidePair, Adlib(Instrument, &H4 + x)
837  OUT Port, &H80 + Operator + (x * &H3)
838  OUT ChannelInsidePair, Adlib(Instrument, &H6 + x)
839  OUT Port, &HE0 + Operator + (x * &H3)
840  OUT ChannelInsidePair, Adlib(Instrument, &H8 + x)
841 NEXT x
842END SUB
843
844SUB OPLReset ()
845DIM ChannelInsidePair
846DIM Operator
847DIM Port
848DIM y                ''What is this variable?
849
850 Port = SetUpOPL(0, Operator, ChannelInsidePair)
851
852 FOR y = &H3 TO &H4
853  OUT Port, &H4
854  OUT Port + &H1, y * &H20
855 NEXT y
856
857 Port = SetUpOPL(9, Operator, ChannelInsidePair)
858 FOR y = &H0 TO &H2
859  OUT Port, &H5
860  OUT Port + &H1, y AND &H1
861 NEXT y
862
863 Port = SetUpOPL(0, Operator, ChannelInsidePair)
864 OUT Port, &H1
865 OUT Port + &H1, OPLENABLEWAVE
866
867 Port = SetUpOPL(0, Operator, ChannelInsidePair)
868 OUT Port, &HBD
869 OUT Port + &H1, OPLMEDOLICMODE
870
871 Port = SetUpOPL(9, Operator, ChannelInsidePair)
872 OUT Port, &H5
873 OUT Port + &H1, OPLENABLEOPL3
874
875 Port = SetUpOPL(9, Operator, ChannelInsidePair)
876 OUT Port, &H4
877 OUT Port + &H1, OPLMODE0
878
879 OPLSilence
880END SUB
881
882SUB OPLSilence ()
883DIM Channel
884
885 FOR Channel = 0 TO 17
886  OPLNoteOff Channel
887  OPLTouchReal Channel, 0
888 NEXT Channel
889END SUB
890
891SUB OPLTouchReal (Channel, Volume)
892DIM ChannelInsidePair
893DIM Instrument
894DIM Operator
895DIM Port
896
897 Port = SetUpOPL(Channel, Operator, ChannelInsidePair)
898 Instrument = ChannelInstruments(Channel).Instrument
899
900 OUT Port, &H40 + Operator
901 ChannelInsidePair = Adlib(Instrument, 2)
902 OUT Port + &H1, (ChannelInsidePair OR &H3F) - Volume + ((ChannelInsidePair AND &H3F) * Volume) \ &H3F
903
904 OUT Port, &H43 + Operator
905 ChannelInsidePair = Adlib(Instrument, 3)
906 OUT Port + &H1, (ChannelInsidePair OR &H3F) - Volume + ((ChannelInsidePair AND &H3F) * Volume) \ &H3F
907END SUB
908
909FUNCTION ParseBEDWord& (Buffer AS STRING)
910DIM DWord AS LONG
911
912 DWord = ASC(MID$(Buffer, &H4, &H1))
913 DWord = DWord OR (ASC(MID$(Buffer, &H3, &H1)) * &H100&)
914 DWord = DWord OR (ASC(MID$(Buffer, &H2, &H1)) * &H10000)
915 ParseBEDWord& = DWord OR (ASC(MID$(Buffer, &H1, &H1)) * &H1000000)
916END FUNCTION
917
918FUNCTION ParseBEWord (Buffer AS STRING)
919DIM Word
920
921 Word = ASC(MID$(Buffer, &H2, &H1))
922 ParseBEWord = Word OR (ASC(MID$(Buffer, &H1, &H1)) * &H100)
923END FUNCTION
924
925SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
926DIM Track
927
928 FOR Track = 0 TO MIDI.TrackCount - 1
929  LoopsBackup(Track).Pointer = Tracks(Track).Pointer
930  LoopsBackup(Track).Delay = Tracks(Track).Delay
931  LoopsBackup(Track).Status = Tracks(Track).Status
932  IF Tracks(Track).Status >= 0 AND Tracks(Track).Delay <= 0 THEN
933   HandleTrackEvent Track, MIDI, Status
934   IF Status.LoopEnd THEN
935
936    ReturnToLoopStart MIDI, Status
937
938    COLOR , 0
939    CLS
940    Status.TextRow = 2
941    DisplayKeys
942   ELSE
943    Tracks(Track).Delay = Tracks(Track).Delay + ReadVariableLengthInteger&
944    Tracks(Track).Pointer = LOC(1)
945   END IF
946  END IF
947 NEXT Track
948
949 IF Status.LoopStart THEN
950  SaveLoopStart MIDI, Status
951 END IF
952
953 DO WHILE ScheduleEventsAfterDelay#(GetShortestDelay&(MIDI.TrackCount), MIDI, Status) < 0
954 LOOP
955END SUB
956
957SUB Quit ()
958 PLAY OFF
959 COLOR 9
960 PRINT "End!"
961 OPLSilence
962 CLOSE #1
963 COLOR 7, 0
964END SUB
965
966FUNCTION ReadVariableLengthInteger& ()
967DIM Byte
968DIM VariableLengthInteger AS LONG
969
970 VariableLengthInteger = &H0
971 DO
972  Byte = ASC(INPUT$(&H1, 1))
973  VariableLengthInteger = (VariableLengthInteger * &H80) OR (Byte AND &H7F)
974 LOOP UNTIL Byte < &H80
975
976 ReadVariableLengthInteger = VariableLengthInteger
977END FUNCTION
978
979FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
980DIM Position
981DIM Result AS STRING
982
983 Result = Text
984 FOR Position = 1 TO LEN(Text)
985  SELECT CASE MID$(Result, Position, 1)
986   CASE IS < " ", IS > "~"
987    MID$(Result, Position, 1) = "?"
988  END SELECT
989 NEXT Position
990
991 RemoveSpecialCharacters$ = Result
992END FUNCTION
993
994SUB ResetAllControllers (Channel)
995 ChannelSettings(Channel).Bend = 0
996 ChannelSettings(Channel).Vibrato = 0
997 ChannelInstruments(Channel).Panning = 0
998 UpdateAllLiveNotes Channel, MOPOFF, 0
999 UpdateAllLiveNotes Channel, MOPPAN, 0
1000END SUB
1001
1002SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
1003DIM Track AS LONG
1004
1005 FOR Track = 0 TO MIDI.TrackCount - 1
1006  Tracks(Track).Pointer = Loops(Track).Pointer
1007  Tracks(Track).Delay = Loops(Track).Delay
1008  Tracks(Track).Status = Loops(Track).Status
1009 NEXT Track
1010
1011 Status.LoopEnd = FALSE
1012 Status.PlayWait = Status.LoopWait
1013END SUB
1014
1015SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
1016DIM Track AS LONG
1017
1018 FOR Track = 0 TO MIDI.TrackCount - 1
1019  Loops(Track).Pointer = LoopsBackup(Track).Pointer
1020  Loops(Track).Delay = LoopsBackup(Track).Delay
1021  Loops(Track).Status = LoopsBackup(Track).Status
1022 NEXT Track
1023
1024 Status.LoopWait = Status.PlayWait
1025 Status.LoopStart = FALSE
1026END SUB
1027
1028FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
1029DIM AgeIncrease AS DOUBLE
1030DIM Channel
1031DIM Track
1032 
1033 AgeIncrease = Delay * MIDI.Tempo
1034
1035 FOR Channel = 0 TO 17
1036  Channels(Channel).Age = Channels(Channel).Age + AgeIncrease
1037 NEXT Channel
1038 
1039 FOR Track = 0 TO MIDI.TrackCount - 1
1040  Tracks(Track).Delay = Tracks(Track).Delay - Delay
1041 NEXT Track
1042
1043 IF Status.Began THEN
1044  Status.PlayWait = Status.PlayWait + AgeIncrease
1045 END IF
1046 
1047 ScheduleEventsAfterDelay# = AgeIncrease
1048END FUNCTION
1049
1050FUNCTION SetUpOPL (Channel, Operator, ChannelInsidePair)
1051DIM Port
1052
1053 Port = &H0
1054
1055 SELECT CASE Channel
1056  CASE 0 TO 8
1057   Port = OPLBASE
1058   ChannelInsidePair = Channel
1059  CASE 9 TO 17
1060   Port = OPLBASE + &H2
1061   ChannelInsidePair = Channel - 9
1062 END SELECT
1063
1064 Operator = (ChannelInsidePair MOD &H3) OR (&H8 * (ChannelInsidePair \ &H3))
1065
1066 SetUpOPL = Port
1067END FUNCTION
1068
1069SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
1070DIM ActiveChannel
1071DIM ActiveCount
1072DIM ActiveNote
1073DIM Note
1074
1075 ActiveCount = ActiveNoteCount(Channel)
1076
1077 FOR ActiveNote = 1 TO ActiveCount
1078  Note = ActList(Channel, ActiveNote)
1079  ActiveChannel = ActAdlChn(Channel, Note)
1080  SELECT CASE MIDIOperation
1081   CASE MOPOFF
1082    DeallocateActiveNote Channel, ActiveNote
1083   CASE MOPPAN
1084    UpdateNotePan ActiveChannel, Channel
1085   CASE MOPPITCH
1086    OPLNoteOn ActiveChannel, 172.00093# * EXP(.057762265# * (ActTone(Channel, Note) + ChannelSettings(Channel).Bend))
1087   CASE MOPPRESSURE
1088    ActVol(Channel, Note) = Volume
1089    UpdateNoteVolume ActiveChannel, Channel, ActVol(Channel, Note)
1090   CASE MOPVOLUME
1091    UpdateNoteVolume ActiveChannel, Channel, ActVol(Channel, Note)
1092  END SELECT
1093 NEXT ActiveNote
1094END SUB
1095
1096SUB UpdateNotePan (ActiveChannel, Channel)
1097DIM ChannelInsidePair
1098DIM Operator
1099DIM Port
1100
1101 ChannelInstruments(ActiveChannel).Panning = ChannelSettings(Channel).Panning
1102 Port = SetUpOPL(ActiveChannel, Operator, ChannelInsidePair)
1103 OUT Port, &HC0 + ChannelInsidePair
1104 OUT Port + &H1, Adlib(ChannelInstruments(ActiveChannel).Instrument, 10) - ChannelInstruments(ActiveChannel).Panning
1105END SUB
1106
1107SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
1108 IF Volume * ChannelSettings(Channel).Volume < 72 THEN
1109  OPLTouchReal ActiveChannel, 0
1110 ELSE
1111  OPLTouchReal ActiveChannel, LOG(Volume * ChannelSettings(Channel).Volume) * 11.541561# - 48.818955#
1112 END IF
1113END SUB

My GitHub:
https://github.com/peterswinkels

Reply 8 of 8, by Peter Swinkels

Posted on 2022-12-19, 18:42

Peter Swinkels Offline

Rank Oldbie

Rank: Oldbie
Posts: 590
Joined: 2005-11-16, 20:32
Location: The Netherlands

1'$DYNAMIC
2DEFINT A-Z
3OPTION BASE 0
4
5CONST DEFAULTTEMPO = 1000000
6CONST EVENTBUFFERSIZE = 2
7CONST EVENTTICKFREQUENCY = 16320
8CONST FALSE = 0
9CONST GP01 = 93
10CONST MAXIMUMSIGNEDBEND = &H2000
11CONST MCALLNOTESOFF = &H7B
12CONST MCBEND = &H6
13CONST MCMODULATION = &H1
14CONST MCPAN = &HA
15CONST MCRESETALLCONTROLLERS = &H79
16CONST MCVOLUME = &H7
17CONST MEBEND = &HE0
18CONST MECHANNELMASK = &HF
19CONST MECONTROLLER = &HB0
20CONST MEFIRST = &H80
21CONST MEINSTRUMENT = &HC0
22CONST MEMASK = &HF0
23CONST MEMETA = &HFF
24CONST MENOTEOFF = &H80
25CONST MENOTEON = &H90
26CONST MEPOLYPHONIC = &HA0
27CONST MEPRESSURE = &HD0
28CONST MESONGPOSITION = &HF2
29CONST MESONGSELECT = &HF3
30CONST MESYSEXEND = &HF7
31CONST MESYSEXSTART = &HF0
32CONST MMEENDOFTRACK = &H2F
33CONST MMESETTEMPO = &H51
34CONST MMETCOPYRIGHT = &H2
35CONST MMETCUE = &H7
36CONST MMETGENERIC = &H1
37CONST MMETINSTRUMENT = &H4
38CONST MMETLYRIC = &H5
39CONST MMETMARKER = &H6
40CONST MMETTRACK = &H3
41CONST MOPOFF = 1
42CONST MOPPAN = 2
43CONST MOPPITCH = 3
44CONST MOPPRESSURE = 4
45CONST MOPVOLUME = 5
46CONST MTHDBLOCKDEFAULTLENGTH = &H6
47CONST NOCHANNEL = -1
48CONST NULL = 0
49CONST OPL01WAVEON = &H20
50CONST OPL04IRQRESET = &H80
51CONST OPL04MODE0 = &H0
52CONST OPL04TIMERS12ON = &H60
53CONST OPL05OPL3OFF = &H0
54CONST OPL05OPL3ON = &H1
55CONST OPLATTENUATIONMASK = &H3F
56CONST OPLBASE = &H388
57CONST OPLB0FREQUENCYMASK = &H3
58CONST OPLB0BLOCKMASK = &H1C
59CONST OPLB0NOTEON = &H20
60CONST OPLBDMEDOLICMODE = &H0

…Show last 1103 lines

61CONST OPLC0RIGHTSPEAKERENABLE = &H20
62CONST OPLC0LEFTSPEAKERENABLE = &H10
63CONST OPLDATA1 = OPLBASE + &H1
64CONST OPLDATA2 = OPLBASE + &H3
65CONST OPLINDEX1 = OPLBASE + &H0
66CONST OPLINDEX2 = OPLBASE + &H2
67CONST OPLMAXIMUMATTENUATION = &H3F
68CONST OPLMAXIMUMVOLUME = &H3F
69CONST PERCUSSIONONLY = &H9
70CONST PERCUSSIVENOTES = &H6
71CONST SIGN14BIT = &H2000
72CONST TRUE = -1
73
74TYPE ActiveNoteStr
75 AdlibChannel AS INTEGER
76 Index AS INTEGER
77 Note AS INTEGER
78 Volume AS INTEGER
79END TYPE
80
81TYPE ChannelStr
82 ActiveIndex AS INTEGER
83 Age AS LONG
84 ColorV AS INTEGER
85 MIDIChannel AS INTEGER
86 IsOn AS INTEGER
87 x AS INTEGER
88 XCharacter AS INTEGER
89 XColor AS INTEGER
90END TYPE
91
92TYPE ChannelInstrumentStr
93 Instrument AS INTEGER
94 Panning AS INTEGER
95 Pitch AS INTEGER
96END TYPE
97
98TYPE ChannelSettingsStr
99 Bend AS DOUBLE
100 Panning AS INTEGER
101 Patch AS INTEGER
102 Vibrato AS INTEGER
103 Volume AS INTEGER
104END TYPE
105
106TYPE MIDIStr
107 BendSense AS DOUBLE
108 Format AS INTEGER
109 InvDeltaTicks AS DOUBLE
110 Tempo AS DOUBLE
111 TrackCount AS LONG
112END TYPE
113
114TYPE OPLStr
115 DataV AS INTEGER
116 Index AS INTEGER
117 Operator AS INTEGER
118 SubChannel AS INTEGER
119END TYPE
120
121TYPE StatusStr
122 Began AS INTEGER
123 LoopEnd AS INTEGER
124 LoopStart AS INTEGER
125 LoopWait AS LONG
126 PlayWait AS LONG
127 TextRow AS INTEGER
128END TYPE
129
130TYPE TrackStr
131 Delay AS LONG
132 Pointer AS LONG
133 Status AS INTEGER
134END TYPE
135
136DECLARE FUNCTION AllocateChannel (Instrument)
137DECLARE FUNCTION GetHertz# (Note, Bend AS DOUBLE)
138DECLARE FUNCTION GetOctave (Hertz AS DOUBLE)
139DECLARE FUNCTION GetShortestDelay& (TrackCount AS LONG)
140DECLARE FUNCTION IsRunningStatus (Byte)
141DECLARE FUNCTION ParseBEDWord& (Buffer AS STRING)
142DECLARE FUNCTION ParseBEWord (Buffer AS STRING)
143DECLARE FUNCTION ReadVariableLengthInteger& ()
144DECLARE FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
145DECLARE FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
146DECLARE SUB ChangePanning (Channel, DataV)
147DECLARE SUB ControllerChange (Channel, MIDI AS MIDIStr)
148DECLARE SUB DeallocateActiveNote (Channel, Note)
149DECLARE SUB Display (Row, Column, ColorV, Text AS STRING)
150DECLARE SUB DisplayKeys ()
151DECLARE SUB DisplayNote (AllocatedChannel, Note)
152DECLARE SUB GetInstrumentData ()
153DECLARE SUB HandleSpecialTrackEvent (MIDISpecialEvent, Track, MIDI AS MIDIStr, Status AS StatusStr)
154DECLARE SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
155DECLARE SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
156DECLARE SUB Initialize (Status AS StatusStr)
157DECLARE SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
158DECLARE SUB NoteOff (Channel)
159DECLARE SUB NoteOn (Channel, Status AS StatusStr)
160DECLARE SUB NoteTouch (Channel)
161DECLARE SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
162DECLARE SUB OPLNoteOff (Channel)
163DECLARE SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
164DECLARE SUB OPLPatch (Channel)
165DECLARE SUB OPLReset ()
166DECLARE SUB OPLSetUp (Channel, OPL AS OPLStr)
167DECLARE SUB OPLSilence ()
168DECLARE SUB OPLTouchReal (Channel, Volume)
169DECLARE SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
170DECLARE SUB Quit ()
171DECLARE SUB ResetAllControllers (Channel)
172DECLARE SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
173DECLARE SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
174DECLARE SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
175DECLARE SUB UpdateNotePan (ActiveChannel, Channel)
176DECLARE SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
177
178DIM MIDI AS MIDIStr
179DIM Status AS StatusStr
180
181DIM SHARED ActiveNote(0 TO 15, 0 TO 127) AS ActiveNoteStr
182DIM SHARED ActiveNoteCount(0 TO 15)
183DIM SHARED ActiveNoteList(0 TO 15, 0 TO 99)
184DIM SHARED Channels(0 TO 17) AS ChannelStr
185DIM SHARED ChannelInstruments(0 TO 17) AS ChannelInstrumentStr
186DIM SHARED ChannelSettings(0 TO 15) AS ChannelSettingsStr
187DIM SHARED Instruments(0 TO 180, 0 TO 6)
188DIM SHARED Loops(0 TO 0) AS TrackStr
189DIM SHARED LoopsBackup(0 TO 0) AS TrackStr
190DIM SHARED Tracks(0 TO 0) AS TrackStr
191
192 Initialize Status
193 CALL Main(MIDI, Status)
194 Quit
195 END
196
197PlayerLoop:
198 IF Status.Began THEN Status.PlayWait = Status.PlayWait - 1
199
200 DO WHILE Status.PlayWait = 0
201  ProcessTrackEvents MIDI, Status
202 LOOP
203 
204 DO WHILE PLAY(0) < EVENTBUFFERSIZE
205  PLAY "P64"
206 LOOP
207
208 RETURN
209
210 'The data words are:
211 '[0] Amplitude Modulator/Vibrato/Envelope Generator/Key Scaling Rate/Etc.
212 '[1] Key Scaling Level/Attenuation settings
213 '[2] Attack and decay rates
214 '[3] Sustain and release rates
215 '[4] Wave select settings
216 '[5] Feedback/connection bits
217 '[6] Percussive instrument (GP35..GP87) notes.
218
219InstrumentData:
220DATA  &H101,  &H68F, &HF2F2, &HF7F4,    &H0,   &H38,    &H0: 'GM1:AcouGrandPiano
221DATA  &H101,   &H4B, &HF2F2, &HF7F4,    &H0,   &H38,    &H0: 'GM2:BrightAcouGrand
222DATA  &H101,   &H49, &HF2F2, &HF6F4,    &H0,   &H38,    &H0: 'GM3:ElecGrandPiano
223DATA &H4181,   &H12, &HF2F2, &HF7F7,    &H0,   &H36,    &H0: 'GM4:Honky-tonkPiano
224DATA  &H101,   &H57, &HF2F1, &HF7F7,    &H0,   &H30,    &H0: 'GM5:Rhodes Piano
225DATA  &H101,   &H93, &HF2F1, &HF7F7,    &H0,   &H30,    &H0: 'GM6:Chorused Piano
226DATA &H1601,  &HE80, &HF2A1, &HF5F2,    &H0,   &H38,    &H0: 'GM7:Harpsichord
227DATA  &H101,   &H92, &HC2C2, &HF8F8,    &H0,   &H3A,    &H0: 'GM8:Clavinet
228DATA &H810C,   &H5C, &HF3F6, &HF5F4,    &H0,   &H30,    &H0: 'GM9:Celesta
229DATA &H1107, &H8097, &HF2F3, &HF1F2,    &H0,   &H32,    &H0: 'GM10:Glockenspiel
230DATA  &H117,   &H21, &HF454, &HF4F4,    &H0,   &H32,    &H0: 'GM11:Music box
231DATA &H8198,   &H62, &HF2F3, &HF6F6,    &H0,   &H30,    &H0: 'GM12:Vibraphone
232DATA  &H118,   &H23, &HE7F6, &HF7F6,    &H0,   &H30,    &H0: 'GM13:Marimba
233DATA  &H115,   &H91, &HF6F6, &HF6F6,    &H0,   &H34,    &H0: 'GM14:Xylophone
234DATA &H8145, &H8059, &HA3D3, &HF3F3,    &H0,   &H3C,    &H0: 'GM15:Tubular Bells
235DATA &H8103, &H8049, &HB575, &HF5F5,    &H1,   &H34,    &H0: 'GM16:Dulcimer
236DATA &H3171,   &H92, &HF1F6,  &H714,    &H0,   &H32,    &H0: 'GM17:Hammond Organ
237DATA &H3072,   &H14, &HC7C7,  &H858,    &H0,   &H32,    &H0: 'GM18:Percussive Organ
238DATA &HB170,   &H44, &H8AAA,  &H818,    &H0,   &H34,    &H0: 'GM19:Rock Organ
239DATA &HB123,   &H93, &H5597, &H1423,    &H1,   &H34,    &H0: 'GM20:Church Organ
240DATA &HB161, &H8013, &H5597,  &H404,    &H1,   &H30,    &H0: 'GM21:Reed Organ
241DATA &HB124,   &H48, &H4698, &H1A2A,    &H1,   &H3C,    &H0: 'GM22:Accordion
242DATA &H2161,   &H13, &H6191,  &H706,    &H1,   &H3A,    &H0: 'GM23:Harmonica
243DATA &HA121, &H8913, &H6171,  &H706,    &H0,   &H36,    &H0: 'GM24:Tango Accordion
244DATA &H4102, &H809C, &HF3F3, &HC894,    &H1,   &H3C,    &H0: 'GM25:Acoustic Guitar1
245DATA &H1103,   &H54, &HF1F3, &HE79A,    &H1,   &H3C,    &H0: 'GM26:Acoustic Guitar2
246DATA &H2123,   &H5F, &HF2F1, &HF83A,    &H0,   &H30,    &H0: 'GM27:Electric Guitar1
247DATA &H2103, &H8087, &HF3F6, &HF822,    &H1,   &H36,    &H0: 'GM28:Electric Guitar2
248DATA &H2103,   &H47, &HF6F9, &H3A54,    &H0,   &H30,    &H0: 'GM29:Electric Guitar3
249DATA &H2123,  &H54A, &H8491, &H1941,    &H1,   &H38,    &H0: 'GM30:Overdrive Guitar
250DATA &H2123,   &H4A, &H9495, &H1919,    &H1,   &H38,    &H0: 'GM31:Distorton Guitar
251DATA &H8409, &H80A1, &HD120, &HF84F,    &H0,   &H38,    &H0: 'GM32:Guitar Harmonics
252DATA &HA221,   &H1E, &HC394, &HA606,    &H0,   &H32,    &H0: 'GM33:Acoustic Bass
253DATA &H3131,   &H12, &HF1F1, &H1828,    &H0,   &H3A,    &H0: 'GM34:Electric Bass 1
254DATA &H3131,   &H8D, &HF1F1, &H78E8,    &H0,   &H3A,    &H0: 'GM35:Electric Bass 2
255DATA &H3231,   &H5B, &H7151, &H4828,    &H0,   &H3C,    &H0: 'GM36:Fretless Bass
256DATA &H2101, &H408B, &HF2A1, &HDF9A,    &H0,   &H38,    &H0: 'GM37:Slap Bass 1
257DATA &H2121,  &H88B, &HA1A2, &HDF16,    &H0,   &H38,    &H0: 'GM38:Slap Bass 2
258DATA &H3131,   &H8B, &HF1F4, &H78E8,    &H0,   &H3A,    &H0: 'GM39:Synth Bass 1
259DATA &H3131,   &H12, &HF1F1, &H1828,    &H0,   &H3A,    &H0: 'GM40:Synth Bass 2
260DATA &H2131,   &H15, &H56DD, &H2613,    &H1,   &H38,    &H0: 'GM41:Violin
261DATA &H2131,   &H16, &H66DD,  &H613,    &H1,   &H38,    &H0: 'GM42:Viola
262DATA &H3171,   &H49, &H61D1,  &HC1C,    &H1,   &H38,    &H0: 'GM43:Cello
263DATA &H2321, &H804D, &H7271,  &H612,    &H1,   &H32,    &H0: 'GM44:Contrabass
264DATA &HE1F1,   &H40, &H6FF1, &H1621,    &H1,   &H32,    &H0: 'GM45:Tremulo Strings
265DATA  &H102, &H801A, &H85F5, &H3575,    &H1,   &H30,    &H0: 'GM46:Pizzicato String
266DATA  &H102, &H801D, &HF3F5, &HF475,    &H1,   &H30,    &H0: 'GM47:Orchestral Harp
267DATA &H1110,   &H41, &HF2F5, &HC305,    &H1,   &H32,    &H0: 'GM48:Timpany
268DATA &HA221,  &H19B, &H72B1,  &H825,    &H1,   &H3E,    &H0: 'GM49:String Ensemble1
269DATA &H21A1,   &H98, &H3F7F,  &H703,  &H101,   &H30,    &H0: 'GM50:String Ensemble2
270DATA &H61A1,   &H93, &H4FC1,  &H512,    &H0,   &H3A,    &H0: 'GM51:Synth Strings 1
271DATA &H6121,   &H18, &H4FC1,  &H522,    &H0,   &H3C,    &H0: 'GM52:SynthStrings 2
272DATA &H7231, &H835B, &H8AF4,  &H515,    &H0,   &H30,    &H0: 'GM53:Choir Aahs
273DATA &H61A1,   &H90, &H7174, &H6739,    &H0,   &H30,    &H0: 'GM54:Voice Oohs
274DATA &H7271,   &H57, &H7A54,  &H505,    &H0,   &H3C,    &H0: 'GM55:Synth Voice
275DATA &H4190,    &H0, &HA554, &H4563,    &H0,   &H38,    &H0: 'GM56:Orchestra Hit
276DATA &H2121,  &H192, &H8F85,  &H917,    &H0,   &H3C,    &H0: 'GM57:Trumpet
277DATA &H2121,  &H594, &H8F75,  &H917,    &H0,   &H3C,    &H0: 'GM58:Trombone
278DATA &H6121,   &H94, &H8276, &H3715,    &H0,   &H3C,    &H0: 'GM59:Tuba
279DATA &H2131,   &H43, &H629E, &H2C17,  &H101,   &H32,    &H0: 'GM60:Muted Trumpet
280DATA &H2121,   &H9B, &H7F61,  &HA6A,    &H0,   &H32,    &H0: 'GM61:French Horn
281DATA &H2261,  &H68A, &H7475,  &HF1F,    &H0,   &H38,    &H0: 'GM62:Brass Section
282DATA &H21A1, &H8386, &H7172, &H1855,    &H1,   &H30,    &H0: 'GM63:Synth Brass 1
283DATA &H2121,   &H4D, &HA654, &H1C3C,    &H0,   &H38,    &H0: 'GM64:Synth Brass 2
284DATA &H6131,   &H8F, &H7293,  &HB02,    &H1,   &H38,    &H0: 'GM65:Soprano Sax
285DATA &H6131,   &H8E, &H7293,  &H903,    &H1,   &H38,    &H0: 'GM66:Alto Sax
286DATA &H6131,   &H91, &H8293,  &H903,    &H1,   &H3A,    &H0: 'GM67:Tenor Sax
287DATA &H6131,   &H8E, &H7293,  &HF0F,    &H1,   &H3A,    &H0: 'GM68:Baritone Sax
288DATA &H2121,   &H4B, &H8FAA,  &HA16,    &H1,   &H38,    &H0: 'GM69:Oboe
289DATA &H2131,   &H90, &H8B7E,  &HC17,  &H101,   &H36,    &H0: 'GM70:English Horn
290DATA &H3231,   &H81, &H6175, &H1919,    &H1,   &H30,    &H0: 'GM71:Bassoon
291DATA &H2132,   &H90, &H729B, &H1721,    &H0,   &H34,    &H0: 'GM72:Clarinet
292DATA &HE1E1,   &H1F, &H6585, &H1A5F,    &H0,   &H30,    &H0: 'GM73:Piccolo
293DATA &HE1E1,   &H46, &H6588, &H1A5F,    &H0,   &H30,    &H0: 'GM74:Flute
294DATA &H21A1,   &H9C, &H7575,  &HA1F,    &H0,   &H32,    &H0: 'GM75:Recorder
295DATA &H2131,   &H8B, &H6584, &H1A58,    &H0,   &H30,    &H0: 'GM76:Pan Flute
296DATA &HA1E1,   &H4C, &H6566, &H2656,    &H0,   &H30,    &H0: 'GM77:Bottle Blow
297DATA &HA162,   &HCB, &H5576, &H3646,    &H0,   &H30,    &H0: 'GM78:Shakuhachi
298DATA &HA162,   &H99, &H5657,  &H707,    &H0,   &H3B,    &H0: 'GM79:Whistle
299DATA &HA162,   &H93, &H7677,  &H707,    &H0,   &H3B,    &H0: 'GM80:Ocarina
300DATA &H2122,   &H59, &HFFFF,  &HF03,    &H2,   &H30,    &H0: 'GM81:Lead 1 squareea
301DATA &H2121,    &HE, &HFFFF,  &HF0F,  &H101,   &H30,    &H0: 'GM82:Lead 2 sawtooth
302DATA &H2122, &H8046, &H6486, &H1855,    &H0,   &H30,    &H0: 'GM83:Lead 3 calliope
303DATA &HA121,   &H45, &H9666,  &HA12,    &H0,   &H30,    &H0: 'GM84:Lead 4 chiff
304DATA &H2221,   &H8B, &H9192, &H2A2A,    &H1,   &H30,    &H0: 'GM85:Lead 5 charang
305DATA &H61A2, &H409E, &H6FDF,  &H705,    &H0,   &H32,    &H0: 'GM86:Lead 6 voice
306DATA &H6020,   &H1A, &H8FEF,  &H601,  &H200,   &H30,    &H0: 'GM87:Lead 7 fifths
307DATA &H2121, &H808F, &HF4F1,  &H929,    &H0,   &H3A,    &H0: 'GM88:Lead 8 brass
308DATA &HA177,   &HA5, &HA053,  &H594,    &H0,   &H32,    &H0: 'GM89:Pad 1 new age
309DATA &HB161, &H801F, &H25A8,  &H311,    &H0,   &H3A,    &H0: 'GM90:Pad 2 warm
310DATA &H6161,   &H17, &H5591, &H1634,    &H0,   &H3C,    &H0: 'GM91:Pad 3 polysynth
311DATA &H7271,   &H5D, &H6A54,  &H301,    &H0,   &H30,    &H0: 'GM92:Pad 4 choir
312DATA &HA221,   &H97, &H4221, &H3543,    &H0,   &H38,    &H0: 'GM93:Pad 5 bowedpad
313DATA &H21A1,   &H1C, &H31A1, &H4777,  &H101,   &H30,    &H0: 'GM94:Pad 6 metallic
314DATA &H6121,  &H389, &H4211, &H2533,    &H0,   &H3A,    &H0: 'GM95:Pad 7 halo
315DATA &H21A1,   &H15, &HCF11,  &H747,    &H1,   &H30,    &H0: 'GM96:Pad 8 sweep
316DATA &H513A,   &HCE, &H86F8,  &H2F6,    &H0,   &H32,    &H0: 'GM97:FX 1 rain
317DATA &H2121,   &H15, &H4121, &H1323,    &H1,   &H30,    &H0: 'GM98:FX 2 soundtrack
318DATA  &H106,   &H5B, &HA574, &H7295,    &H0,   &H30,    &H0: 'GM99:FX 3 crystal
319DATA &H6122, &H8392, &HF2B1, &H2681,    &H0,   &H3C,    &H0: 'GM100:FX 4 atmosphere
320DATA &H4241,   &H4D, &HF2F1, &HF551,    &H1,   &H30,    &H0: 'GM101:FX 5 brightness
321DATA &HA361, &H8094, &H1111, &H1351,    &H1,   &H36,    &H0: 'GM102:FX 6 goblins
322DATA &HA161, &H808C, &H1D11,  &H331,    &H0,   &H36,    &H0: 'GM103:FX 7 echoes
323DATA &H61A4,   &H4C, &H81F3, &H2373,    &H1,   &H34,    &H0: 'GM104:FX 8 sci-fi
324DATA  &H702,  &H385, &HF2D2, &HF653,  &H100,   &H30,    &H0: 'GM105:Sitar
325DATA &H1311, &H800C, &HA2A3, &HE511,    &H1,   &H30,    &H0: 'GM106:Banjo
326DATA &H1111,    &H6, &HF2F6, &HE641,  &H201,   &H34,    &H0: 'GM107:Shamisen
327DATA &H9193,   &H91, &HEBD4, &H1132,  &H100,   &H38,    &H0: 'GM108:Koto
328DATA  &H104,   &H4F, &HC2FA,  &H556,    &H0,   &H3C,    &H0: 'GM109:Kalimba
329DATA &H2221,   &H49, &H6F7C,  &HC20,  &H100,   &H36,    &H0: 'GM110:Bagpipe
330DATA &H2131,   &H85, &H56DD, &H1633,    &H1,   &H3A,    &H0: 'GM111:Fiddle
331DATA &H2120, &H8104, &H8FDA,  &HB05,    &H2,   &H36,    &H0: 'GM112:Shanai
332DATA  &H305, &H806A, &HC3F1, &HE5E5,    &H0,   &H36,    &H0: 'GM113:Tinkle Bell
333DATA  &H207,   &H15, &HF8EC, &H1626,    &H0,   &H3A,    &H0: 'GM114:Agogo Bells
334DATA  &H105,   &H9D, &HDF67,  &H535,    &H0,   &H38,    &H0: 'GM115:Steel Drums
335DATA &H1218,   &H96, &HF8FA, &HE528,    &H0,   &H3A,    &H0: 'GM116:Woodblock
336DATA   &H10,  &H386, &HFAA8,  &H307,    &H0,   &H36,    &H0: 'GM117:Taiko Drum
337DATA &H1011,  &H341, &HF3F8,  &H347,    &H2,   &H34,    &H0: 'GM118:Melodic Tom
338DATA &H1001,   &H8E, &HF3F1,  &H206,    &H2,   &H3E,    &H0: 'GM119:Synth Drum
339DATA &HC00E,    &H0, &H1F1F, &HFF00,  &H300,   &H3E,    &H0: 'GM120:Reverse Cymbal
340DATA  &H306, &H8880, &H56F8, &H8424,  &H200,   &H3E,    &H0: 'GM121:Guitar FretNoise
341DATA &HD00E,  &H500, &H34F8,  &H400,  &H300,   &H3E,    &H0: 'GM122:Breath Noise
342DATA &HC00E,    &H0, &H1FF6,  &H200,  &H300,   &H3E,    &H0: 'GM123:Seashore
343DATA &HDAD5, &H4095, &H5637, &H37A3,    &H0,   &H30,    &H0: 'GM124:Bird Tweet
344DATA &H1435,  &H85C, &HF4B2, &H1561,    &H2,   &H3A,    &H0: 'GM125:Telephone
345DATA &HD00E,    &H0, &H4FF6, &HF500,  &H300,   &H3E,    &H0: 'GM126:Helicopter
346DATA &HE426,    &H0, &H12FF, &H1601,  &H100,   &H3E,    &H0: 'GM127:Applause/Noise
347DATA    &H0,    &H0, &HF6F3, &HC9F0,  &H200,   &H3E,    &H0: 'GM128:Gunshot
348DATA &H1110,   &H44, &HF3F8,  &H677,    &H2,   &H38,   &H23: 'GP35:Ac Bass Drum
349DATA &H1110,   &H44, &HF3F8,  &H677,    &H2,   &H38,   &H23: 'GP36:Bass Drum 1
350DATA &H1102,    &H7, &HF8F9, &HFFFF,    &H0,   &H38,   &H34: 'GP37:Side Stick
351DATA    &H0,    &H0, &HFAFC, &H1705,    &H2,   &H3E,   &H30: 'GP38:Acoustic Snare
352DATA  &H100,    &H2, &HFFFF,  &H807,    &H0,   &H30,   &H3A: 'GP39:Hand Clap
353DATA    &H0,    &H0, &HFAFC, &H1705,    &H2,   &H3E,   &H3C: 'GP40:Electric Snare
354DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H2F: 'GP41:Low Floor Tom
355DATA &H120C,    &H0, &HFBF6, &H4708,  &H200,   &H3A,   &H2B: 'GP42:Closed High Hat
356DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H31: 'GP43:High Floor Tom
357DATA &H120C,  &H500, &H7BF6, &H4708,  &H200,   &H3A,   &H2B: 'GP44:Pedal High Hat
358DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H33: 'GP45:Low Tom
359DATA &H120C,    &H0, &HCBF6, &H4302,  &H200,   &H3A,   &H2B: 'GP46:Open High Hat
360DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H36: 'GP47:Low-Mid Tom
361DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H39: 'GP48:High-Mid Tom
362DATA &HD00E,    &H0, &H9FF6,  &H200,  &H300,   &H3E,   &H48: 'GP49:Crash Cymbal 1
363DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H3C: 'GP50:High Tom
364DATA  &H70E, &H4A08, &HF4F8, &HE442,  &H300,   &H3E,   &H4C: 'GP51:Ride Cymbal 1
365DATA &HD00E,  &HA00, &H9FF5,  &H230,    &H0,   &H3E,   &H54: 'GP52:Chinese Cymbal
366DATA  &H70E, &H5D0A, &HF5E4, &HE5E4,  &H103,   &H36,   &H24: 'GP53:Ride Bell
367DATA  &H502,  &HA03, &H97B4, &HF704,    &H0,   &H3E,   &H41: 'GP54:Tambourine
368DATA &H9E4E,    &H0, &H9FF6,  &H200,  &H300,   &H3E,   &H54: 'GP55:Splash Cymbal
369DATA &H1011,  &H845, &HF3F8,  &H537,    &H2,   &H38,   &H53: 'GP56:Cow Bell
370DATA &HD00E,    &H0, &H9FF6,  &H200,  &H300,   &H3E,   &H54: 'GP57:Crash Cymbal 2
371DATA &H1080,  &HD00, &HFFFF, &H1403,    &H3,   &H3C,   &H18: 'GP58:Vibraslap
372DATA  &H70E, &H4A08, &HF4F8, &HE442,  &H300,   &H3E,   &H4D: 'GP59:Ride Cymbal 2
373DATA  &H206,    &HB, &HF5F5,  &H80C,    &H0,   &H36,   &H3C: 'GP60:High Bongo
374DATA  &H201,    &H0, &HC8FA, &H97BF,    &H0,   &H37,   &H41: 'GP61:Low Bongo
375DATA  &H101,   &H51, &HFAFA, &HB787,    &H0,   &H36,   &H3B: 'GP62:Mute High Conga
376DATA  &H201,   &H54, &HF8FA, &HB88D,    &H0,   &H36,   &H33: 'GP63:Open High Conga
377DATA  &H201,   &H59, &HF8FA, &HB688,    &H0,   &H36,   &H2D: 'GP64:Low Conga
378DATA    &H1,    &H0, &HFAF9,  &H60A,    &H3,   &H3E,   &H47: 'GP65:High Timbale
379DATA    &H0,   &H80, &HF6F9, &H6C89,    &H3,   &H3E,   &H3C: 'GP66:Low Timbale
380DATA  &HC03,  &H880, &HF6F8, &HB688,    &H3,   &H3F,   &H3A: 'GP67:High Agogo
381DATA  &HC03,   &H85, &HF6F8, &HB688,    &H3,   &H3F,   &H35: 'GP68:Low Agogo
382DATA    &HE,  &H840, &H7776, &H184F,  &H200,   &H3E,   &H40: 'GP69:Cabasa
383DATA  &H30E,   &H40, &H9BC8, &H6949,  &H200,   &H3E,   &H47: 'GP70:Maracas
384DATA &HC7D7,   &HDC, &H8DAD,  &H505,    &H3,   &H3E,   &H3D: 'GP71:Short Whistle
385DATA &HC7D7,   &HDC, &H88A8,  &H404,    &H3,   &H3E,   &H3D: 'GP72:Long Whistle
386DATA &H1180,    &H0, &H67F6, &H1706,  &H303,   &H3E,   &H2C: 'GP73:Short Guiro
387DATA &H1180,  &H900, &H46F5, &H1605,  &H302,   &H3E,   &H28: 'GP74:Long Guiro
388DATA &H1506,   &H3F, &HF700, &HF5F4,    &H0,   &H31,   &H45: 'GP75:Claves
389DATA &H1206,   &H3F, &HF700, &HF5F4,    &H3,   &H30,   &H44: 'GP76:High Wood Block
390DATA &H1206,   &H3F, &HF700, &HF5F4,    &H0,   &H31,   &H3F: 'GP77:Low Wood Block
391DATA  &H201,   &H58, &H7567,  &H7E7,    &H0,   &H30,   &H4A: 'GP78:Mute Cuica
392DATA &H4241,  &H845, &H75F8,  &H548,    &H0,   &H30,   &H3C: 'GP79:Open Cuica
393DATA &H1E0A, &H4E40, &HFFE0,  &H5F0,    &H3,   &H38,   &H50: 'GP80:Mute Triangle
394DATA &H1E0A, &H527C, &HFFE0,  &H2F0,    &H3,   &H38,   &H40: 'GP81:Open Triangle
395DATA    &HE,  &H840, &H7B7A, &H1B4A,  &H200,   &H3E,   &H48: 'GP82
396DATA  &H70E, &H400A, &H55E4, &H39E4,  &H103,   &H36,   &H49: 'GP83
397DATA  &H405, &H4005, &HD6F9, &HA532,    &H3,   &H3E,   &H46: 'GP84
398DATA &H1502,   &H3F, &HF700, &HF5F3,    &H3,   &H38,   &H44: 'GP85
399DATA  &H201,   &H4F, &HF8FA, &HB58D,    &H0,   &H37,   &H30: 'GP86
400DATA    &H0,    &H0, &HF6F6,  &H60C,    &H0,   &H34,   &H35: 'GP87
401
402REM $STATIC
403FUNCTION AllocateChannel (Instrument)
404DIM AllocatedChannel
405DIM CandidateChannel
406DIM HighestScore AS DOUBLE
407DIM Score AS DOUBLE
408
409 AllocatedChannel = NOCHANNEL
410 HighestScore = &H80000000
411 Score = &H0
412 FOR CandidateChannel = LBOUND(Channels) TO UBOUND(Channels)
413  IF Channels(CandidateChannel).IsOn THEN
414   Score = &H0
415   IF ChannelInstruments(CandidateChannel).Instrument = Instrument THEN
416    Score = Score + .2
417   ELSEIF Instrument < &H80 AND ChannelInstruments(CandidateChannel).Instrument > &H7F THEN
418    Score = (Score * &H2) + &H9
419   END IF
420  ELSE
421   Score = (Score + Channels(CandidateChannel).Age) + &HBB8
422  END IF
423
424  IF Score > HighestScore THEN
425   HighestScore = Score
426   AllocatedChannel = CandidateChannel
427  END IF
428 NEXT CandidateChannel
429
430 AllocateChannel = AllocatedChannel
431END FUNCTION
432
433SUB ChangePanning (Channel, DataV)
434DIM Panning
435
436 Panning = NULL
437 IF DataV < &H30 THEN
438  Panning = OPLC0RIGHTSPEAKERENABLE
439 ELSEIF DataV >= &H50 THEN
440  Panning = OPLC0LEFTSPEAKERENABLE
441 END IF
442
443 ChannelSettings(Channel).Panning = Panning
444END SUB
445
446SUB ControllerChange (Channel, MIDI AS MIDIStr)
447DIM Controller
448DIM DataV
449
450 Controller = ASC(INPUT$(&H1, 1))
451 DataV = ASC(INPUT$(&H1, 1))
452
453 SELECT CASE Controller
454  CASE MCMODULATION
455   ChannelSettings(Channel).Vibrato = DataV
456   UpdateAllLiveNotes Channel, MOPPAN, NULL
457  CASE MCBEND
458   MIDI.BendSense = DataV / MAXIMUMSIGNEDBEND
459  CASE MCVOLUME
460   ChannelSettings(Channel).Volume = DataV
461  CASE MCPAN
462   ChangePanning Channel, DataV
463  CASE MCRESETALLCONTROLLERS
464   ResetAllControllers Channel
465  CASE MCALLNOTESOFF
466   UpdateAllLiveNotes Channel, MOPVOLUME, NULL
467 END SELECT
468END SUB
469
470SUB DeallocateActiveNote (Channel, ActiveNote)
471DIM DeactivatedNoteChannel
472DIM NoteToDeactivate
473
474 NoteToDeactivate = ActiveNoteList(Channel, ActiveNote)
475 ActiveNote(Channel, NoteToDeactivate).Index = &H0
476 DeactivatedNoteChannel = ActiveNote(Channel, NoteToDeactivate).AdlibChannel
477 Channels(DeactivatedNoteChannel).Age = &H0
478 Channels(DeactivatedNoteChannel).IsOn = FALSE
479
480 OPLNoteOff DeactivatedNoteChannel
481
482 IF Channels(DeactivatedNoteChannel).XCharacter = 32 THEN
483  Display 20 - DeactivatedNoteChannel, Channels(DeactivatedNoteChannel).x, 1, "."
484 ELSE
485  Display 20 - DeactivatedNoteChannel, Channels(DeactivatedNoteChannel).x, Channels(DeactivatedNoteChannel).XColor, CHR$(Channels(DeactivatedNoteChannel).XCharacter)
486 END IF
487
488 IF NOT ActiveNote = ActiveNoteCount(Channel) THEN
489  NoteToDeactivate = ActiveNoteList(Channel, ActiveNoteCount(Channel))
490  ActiveNoteList(Channel, ActiveNote) = NoteToDeactivate
491  ActiveNote(Channel, NoteToDeactivate).Index = ActiveNote
492  Channels(ActiveNote(Channel, NoteToDeactivate).AdlibChannel).ActiveIndex = ActiveNote
493 END IF
494
495 ActiveNoteCount(Channel) = ActiveNoteCount(Channel) - 1
496END SUB
497
498SUB Display (Row, Column, ColorV, Text AS STRING)
499 COLOR ColorV
500 IF NOT Column = NULL THEN LOCATE , Column
501 IF NOT Row = NULL THEN LOCATE Row
502 PRINT Text;
503END SUB
504
505SUB DisplayKeys ()
506 Display 1, 1, 15, "Press Q to quit"
507END SUB
508
509SUB DisplayNote (AllocatedChannel, Note)
510DIM x
511DIM y
512
513 Channels(AllocatedChannel).x = (Note MOD 80) + 1
514 Channels(AllocatedChannel).ColorV = 9 + (ChannelInstruments(AllocatedChannel).Instrument MOD &H6)
515 y = 20 - AllocatedChannel
516 x = Channels(AllocatedChannel).x
517 Channels(AllocatedChannel).XCharacter = SCREEN(y, x, FALSE)
518 Channels(AllocatedChannel).XColor = SCREEN(y, x, TRUE)
519 Display y, x, Channels(AllocatedChannel).ColorV, "#"
520END SUB
521
522FUNCTION GetHertz# (Note, Bend AS DOUBLE)
523 '''!!!
524 GetHertz# = 172.00093# * (EXP(.057762265# * (Note + Bend)))
525END FUNCTION
526
527SUB GetInstrumentData ()
528DIM Column
529DIM Instrument
530
531 RESTORE InstrumentData
532 FOR Instrument = LBOUND(Instruments, 1) TO UBOUND(Instruments, 1)
533  FOR Column = LBOUND(Instruments, 2) TO UBOUND(Instruments, 2)
534   READ Instruments(Instrument, Column)
535  NEXT Column
536 NEXT Instrument
537END SUB
538
539FUNCTION GetOctave (Hertz AS DOUBLE)
540'''!!!
541DIM Octave
542
543 Octave = &H0
544 DO WHILE Hertz >= 1023.5
545  Hertz = Hertz / &H2
546  Octave = Octave + &H400
547 LOOP
548 
549 GetOctave = Octave + CINT(Hertz)
550END FUNCTION
551
552FUNCTION GetShortestDelay& (TrackCount AS LONG)
553DIM ShortestDelay AS LONG
554DIM Track
555
556 ShortestDelay = -1
557 FOR Track = 0 TO TrackCount - 1
558  IF Tracks(Track).Status >= 0 THEN
559   IF ShortestDelay = -1 OR Tracks(Track).Delay < ShortestDelay THEN
560    ShortestDelay = Tracks(Track).Delay
561   END IF
562  END IF
563 NEXT Track
564
565 GetShortestDelay& = ShortestDelay
566END FUNCTION
567
568SUB HandleSpecialTrackEvent (MIDISpecialEvent, Track, MIDI AS MIDIStr, Status AS StatusStr)
569DIM Ignored AS LONG
570
571 SELECT CASE MIDISpecialEvent
572  CASE MESONGPOSITION
573   SEEK #1, SEEK(1) + &H2
574  CASE MESONGSELECT
575   SEEK #1, SEEK(1) + &H1
576  CASE MESYSEXSTART, MESYSEXEND
577   Ignored = ReadVariableLengthInteger&
578  CASE ELSE
579   HandleSpecialTrackMetaEvent Track, MIDI, Status
580 END SELECT
581END SUB
582
583SUB HandleSpecialTrackMetaEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
584DIM EventType
585DIM StringV AS STRING
586
587 EventType = ASC(INPUT$(&H1, 1))
588 StringV = INPUT$(ReadVariableLengthInteger&, 1)
589
590 SELECT CASE EventType
591  CASE MMETMARKER
592   IF StringV = "loopStart" THEN
593    Status.LoopStart = TRUE
594   ELSEIF StringV = "loopEnd" THEN
595    Status.LoopEnd = TRUE
596   END IF
597  CASE MMEENDOFTRACK
598   Tracks(Track).Status = -1
599   Status.LoopEnd = TRUE
600  CASE MMESETTEMPO
601   MIDI.Tempo = ParseBEDWord&(CHR$(&H0) + StringV) * MIDI.InvDeltaTicks
602  CASE MMETCOPYRIGHT, MMETGENERIC, MMETINSTRUMENT, MMETLYRIC, MMETMARKER, MMETTRACK
603   Status.TextRow = 3 + (Status.TextRow - 2) MOD 20
604   Display Status.TextRow, 1, 8, "Meta" + STR$(EventType) + ": " + RemoveSpecialCharacters$(StringV)
605 END SELECT
606END SUB
607
608SUB HandleTrackEvent (Track, MIDI AS MIDIStr, Status AS StatusStr)
609DIM Byte
610DIM Channel
611DIM MIDIEvent
612
613 SEEK #1, Tracks(Track).Pointer + &H1
614 Byte = ASC(INPUT$(&H1, 1))
615
616 IF Byte < MESYSEXSTART THEN
617  IF IsRunningStatus(Byte) THEN
618   Byte = Tracks(Track).Status OR MEFIRST
619   SEEK #1, Tracks(Track).Pointer + &H1
620  END IF
621  
622  Tracks(Track).Status = Byte
623
624  Channel = Byte AND MECHANNELMASK
625  MIDIEvent = Byte AND MEMASK
626
627  SELECT CASE MIDIEvent
628   CASE MENOTEOFF
629    NoteOff Channel
630   CASE MENOTEON
631    NoteOn Channel, Status
632   CASE MEPOLYPHONIC
633    NoteTouch Channel
634   CASE MECONTROLLER
635    ControllerChange Channel, MIDI
636   CASE MEINSTRUMENT
637    ChannelSettings(Channel).Patch = ASC(INPUT$(&H1, 1))
638   CASE MEPRESSURE
639    UpdateAllLiveNotes Channel, MOPPRESSURE, ASC(INPUT$(&H1, 1))
640   CASE MEBEND
641    ChannelSettings(Channel).Bend = (((ASC(INPUT$(&H1, 1)) AND &H7F) OR (ASC(INPUT$(&H1, 1)) * &H80)) - SIGN14BIT) * MIDI.BendSense
642    UpdateAllLiveNotes Channel, MOPPITCH, NULL
643  END SELECT
644 ELSE
645  HandleSpecialTrackEvent Byte, Track, MIDI, Status
646 END IF
647END SUB
648
649SUB Initialize (Status AS StatusStr)
650DIM Channel
651 
652 SCREEN 0
653 WIDTH 80, 25
654 PALETTE
655 COLOR 7, 0
656 CLS
657
658 GetInstrumentData
659 OPLReset
660 OPLReset
661
662 FOR Channel = LBOUND(ChannelSettings) TO UBOUND(ChannelSettings)
663  ChannelSettings(Channel).Volume = &H7F
664 NEXT Channel
665
666 Status.Began = FALSE
667 Status.LoopEnd = FALSE
668 Status.LoopStart = TRUE
669 Status.LoopWait = 0
670 Status.PlayWait = 0
671 Status.TextRow = 2
672
673 PLAY ON
674 ON PLAY(EVENTBUFFERSIZE) GOSUB PlayerLoop
675 PLAY "ML MB T255"
676END SUB
677
678FUNCTION IsRunningStatus (Byte)
679 IsRunningStatus = ((Byte AND MEFIRST) = &H0)
680END FUNCTION
681
682SUB Main (MIDI AS MIDIStr, Status AS StatusStr)
683DIM FileName AS STRING
684DIM KeyStroke AS STRING
685
686 FileName = COMMAND$
687
688 IF FileName = "" THEN
689  Display 1, 1, 15, "No file specified."
690 ELSE
691  OpenMIDI FileName, MIDI
692  PLAY "T255 P64 P64"
693
694  DisplayKeys
695
696  DO
697   KeyStroke = INKEY$
698
699   SELECT CASE KeyStroke
700    CASE "q", "Q"
701     EXIT DO
702   END SELECT
703  LOOP
704 END IF
705END SUB
706
707SUB NoteOff (Channel)
708DIM ActiveNote
709DIM Note
710
711 Note = ASC(INPUT$(&H1, 1))
712 SEEK #1, SEEK(1) + &H1
713
714 ChannelSettings(Channel).Bend = &H0
715 ActiveNote = ActiveNote(Channel, Note).Index
716 IF NOT ActiveNote = &H0 THEN
717  DeallocateActiveNote Channel, ActiveNote
718 END IF
719END SUB
720
721SUB NoteOn (Channel, Status AS StatusStr)
722DIM ActiveNoteCount
723DIM AllocatedChannel
724DIM Instrument
725DIM NoteToBePlayed
726DIM TrackNote
727DIM Volume
728
729 TrackNote = ASC(INPUT$(&H1, 1))
730 Volume = ASC(INPUT$(&H1, 1))
731
732 IF Volume = NULL THEN
733  ActiveNoteCount = ActiveNote(Channel, TrackNote).Index
734  IF NOT ActiveNoteCount = 0 THEN
735   DeallocateActiveNote Channel, ActiveNoteCount
736  END IF
737 ELSE
738  IF ActiveNote(Channel, TrackNote).Index = &H0 THEN
739   IF Channel = PERCUSSIONONLY THEN
740    Instrument = GP01 + TrackNote
741    NoteToBePlayed = Instruments(Instrument, PERCUSSIVENOTES)
742   ELSE
743    Instrument = ChannelSettings(Channel).Patch
744    NoteToBePlayed = TrackNote
745   END IF
746
747   AllocatedChannel = AllocateChannel(Instrument)
748
749   IF Channels(AllocatedChannel).IsOn THEN
750    DeallocateActiveNote Channels(AllocatedChannel).MIDIChannel, Channels(AllocatedChannel).ActiveIndex
751   END IF
752
753   Channels(AllocatedChannel).Age = &H0
754   ChannelInstruments(AllocatedChannel).Instrument = Instrument
755   Channels(AllocatedChannel).IsOn = TRUE
756   Status.Began = TRUE
757
758   ActiveNoteCount = ActiveNoteCount(Channel) + 1
759   ActiveNote(Channel, TrackNote).Index = ActiveNoteCount
760   ActiveNoteList(Channel, ActiveNoteCount) = TrackNote
761   ActiveNoteCount(Channel) = ActiveNoteCount
762
763   ActiveNote(Channel, TrackNote).AdlibChannel = AllocatedChannel
764   ActiveNote(Channel, TrackNote).Note = NoteToBePlayed
765   ActiveNote(Channel, TrackNote).Volume = Volume
766   Channels(AllocatedChannel).MIDIChannel = Channel
767   Channels(AllocatedChannel).ActiveIndex = ActiveNoteCount
768   OPLPatch AllocatedChannel
769   UpdateNotePan AllocatedChannel, Channel
770   UpdateNoteVolume AllocatedChannel, Channel, Volume
771
772   DisplayNote AllocatedChannel, TrackNote
773
774   OPLNoteOn AllocatedChannel, GetHertz#(TrackNote, ChannelSettings(Channel).Bend)
775   UpdateNoteVolume AllocatedChannel, Channel, Volume
776  END IF
777 END IF
778END SUB
779
780SUB NoteTouch (Channel)
781DIM ActiveChannel
782DIM Note
783DIM Volume
784
785 Note = ASC(INPUT$(&H1, 1))
786 Volume = ASC(INPUT$(&H1, 1))
787 IF NOT ActiveNote(Channel, Note).Index = &H0 THEN
788  ActiveChannel = ActiveNote(Channel, Note).AdlibChannel
789  Display 20 - ActiveChannel, Channels(ActiveChannel).x, Channels(ActiveChannel).ColorV, "&"
790  ActiveNote(Channel, Note).Volume = Volume
791  UpdateNoteVolume ActiveChannel, Channel, Volume
792 END IF
793END SUB
794
795SUB OpenMIDI (FileName AS STRING, MIDI AS MIDIStr)
796DIM TicksPerQuarterNote
797DIM Track
798DIM TrackDelayPosition AS LONG
799DIM TrackLength AS LONG
800
801 OPEN FileName$ FOR INPUT LOCK READ AS #1
802 CLOSE #1
803
804 OPEN FileName$ FOR BINARY LOCK READ WRITE AS #1
805  IF INPUT$(&H4, 1) = "MThd" THEN
806   IF ParseBEDWord&(INPUT$(&H4, 1)) = MTHDBLOCKDEFAULTLENGTH THEN
807    MIDI.Format = ParseBEWord(INPUT$(&H2, 1))
808    MIDI.TrackCount = ParseBEWord(INPUT$(&H2, 1))
809
810    REDIM Loops(0 TO MIDI.TrackCount - 1) AS TrackStr
811    REDIM LoopsBackup(0 TO MIDI.TrackCount - 1) AS TrackStr
812    REDIM Tracks(0 TO MIDI.TrackCount - 1) AS TrackStr
813    
814    TicksPerQuarterNote = ParseBEWord(INPUT$(&H2, 1))
815    '''!!!
816    MIDI.InvDeltaTicks = EVENTTICKFREQUENCY / (240000000# * TicksPerQuarterNote)
817    MIDI.Tempo = DEFAULTTEMPO * MIDI.InvDeltaTicks
818    '''!!!
819
820    MIDI.BendSense = &H2 / MAXIMUMSIGNEDBEND
821
822    FOR Track = 0 TO MIDI.TrackCount - 1
823     IF INPUT$(&H4, 1) = "MTrk" THEN
824      TrackLength = ParseBEDWord&(INPUT$(&H4, 1))
825      TrackDelayPosition = LOC(1)
826      Tracks(Track).Delay = ReadVariableLengthInteger&
827      Tracks(Track).Pointer = LOC(1)
828      SEEK #1, (TrackDelayPosition + TrackLength) + &H1
829     ELSE
830      ERROR 13
831     END IF
832    NEXT Track
833   ELSE
834    ERROR 6
835   END IF
836  ELSE
837   ERROR 13
838  END IF
839END SUB
840
841SUB OPLNoteOff (Channel)
842DIM OPL AS OPLStr
843
844 OPLSetUp Channel, OPL
845 OUT OPL.Index, &HB0 OR OPL.SubChannel
846 OUT OPL.DataV, ChannelInstruments(Channel).Pitch AND (OPLB0FREQUENCYMASK OR OPLB0BLOCKMASK)
847END SUB
848
849SUB OPLNoteOn (Channel, Hertz AS DOUBLE)
850DIM Octave
851DIM OPL AS OPLStr
852
853 Octave = GetOctave(Hertz)
854 OPLSetUp Channel, OPL
855
856 OUT OPL.Index, &HA0 OR OPL.SubChannel
857 OUT OPL.DataV, Octave AND &HFF&
858
859 OUT OPL.Index, &HB0 OR OPL.SubChannel
860 OUT OPL.DataV, (((Octave AND &HFF00&) \ &H100&) AND (OPLB0FREQUENCYMASK OR OPLB0BLOCKMASK)) OR OPLB0NOTEON
861
862 ChannelInstruments(Channel).Pitch = (Octave AND &HFF00) \ &H100&
863END SUB
864
865SUB OPLPatch (Channel)
866DIM Instrument
867DIM OPL AS OPLStr
868
869 Instrument = ChannelInstruments(Channel).Instrument
870
871 OPLSetUp Channel, OPL
872
873 OUT OPL.Index, &H20 + OPL.Operator
874 OUT OPL.DataV, Instruments(Instrument, &H0) AND &HFF&
875 OUT OPL.Index, &H60 + OPL.Operator
876 OUT OPL.DataV, Instruments(Instrument, &H2) AND &HFF&
877 OUT OPL.Index, &H80 + OPL.Operator
878 OUT OPL.DataV, Instruments(Instrument, &H3) AND &HFF&
879 OUT OPL.Index, &HE0 + OPL.Operator
880 OUT OPL.DataV, Instruments(Instrument, &H4) AND &HFF&
881
882 OUT OPL.Index, &H20 + OPL.Operator + &H3
883 OUT OPL.DataV, (Instruments(Instrument, &H0) AND &HFF00&) / &H100&
884 OUT OPL.Index, &H60 + OPL.Operator + &H3
885 OUT OPL.DataV, (Instruments(Instrument, &H2) AND &HFF00&) / &H100&
886 OUT OPL.Index, &H80 + OPL.Operator + &H3
887 OUT OPL.DataV, (Instruments(Instrument, &H3) AND &HFF00&) / &H100&
888 OUT OPL.Index, &HE0 + OPL.Operator + &H3
889 OUT OPL.DataV, (Instruments(Instrument, &H4) AND &HFF00&) / &H100&
890END SUB
891
892SUB OPLReset ()
893DIM OPL AS OPLStr
894
895 OPLSetUp NULL, OPL
896 OUT OPL.Index, &H4
897 OUT OPL.DataV, OPL04TIMERS12ON
898 OUT OPL.Index, &H4
899 OUT OPL.DataV, OPL04IRQRESET
900
901 OPLSetUp PERCUSSIONONLY, OPL
902 OUT OPL.Index, &H5
903 OUT OPL.DataV, OPL05OPL3OFF
904 OUT OPL.Index, &H5
905 OUT OPL.DataV, OPL05OPL3ON
906 OUT OPL.Index, &H5
907 OUT OPL.DataV, OPL05OPL3OFF
908
909 OPLSetUp NULL, OPL
910 OUT OPL.Index, &H1
911 OUT OPL.DataV, OPL01WAVEON
912
913 OUT OPL.Index, &HBD
914 OUT OPL.DataV, OPLBDMEDOLICMODE
915
916 OPLSetUp PERCUSSIONONLY, OPL
917 OUT OPL.Index, &H5
918 OUT OPL.DataV, OPL05OPL3ON
919
920 OPLSetUp PERCUSSIONONLY, OPL
921 OUT OPL.Index, &H4
922 OUT OPL.DataV, OPL04MODE0
923
924 OPLSilence
925END SUB
926
927SUB OPLSetUp (Channel, OPL AS OPLStr)
928 OPL.DataV = &H0
929 OPL.Index = &H0
930 OPL.Operator = &H0
931 OPL.SubChannel = &H0
932
933 SELECT CASE Channel
934  CASE &H0 TO &H8
935   OPL.DataV = OPLDATA1
936   OPL.Index = OPLINDEX1
937   OPL.SubChannel = Channel
938  CASE &H9 TO &H11
939   OPL.DataV = OPLDATA2
940   OPL.Index = OPLINDEX2
941   OPL.SubChannel = Channel - &H9
942 END SELECT
943
944 OPL.Operator = (OPL.SubChannel MOD &H3) OR (&H8 * (OPL.SubChannel \ &H3))
945END SUB
946
947SUB OPLSilence ()
948DIM Channel
949
950 FOR Channel = LBOUND(Channels) TO UBOUND(Channels)
951  OPLNoteOff Channel
952  OPLTouchReal Channel, &H0
953 NEXT Channel
954END SUB
955
956SUB OPLTouchReal (Channel, Volume)
957DIM Attenuation
958DIM Instrument
959DIM KSLA
960DIM OPL AS OPLStr
961
962 Instrument = ChannelInstruments(Channel).Instrument
963
964 OPLSetUp Channel, OPL
965
966 KSLA = Instruments(Instrument, 1) AND &HFF&
967 Attenuation = ((KSLA AND OPLATTENUATIONMASK) * Volume) \ OPLMAXIMUMVOLUME
968 
969 OUT OPL.Index, &H40 + OPL.Operator
970 OUT OPL.DataV, ((KSLA OR OPLMAXIMUMATTENUATION) - Volume) + Attenuation
971                               
972 KSLA = (Instruments(Instrument, 1) AND &HFF00&) / &H100&
973 Attenuation = ((KSLA AND OPLATTENUATIONMASK) * Volume) \ OPLMAXIMUMVOLUME
974
975 OUT OPL.Index, &H43 + OPL.Operator
976 OUT OPL.DataV, ((KSLA OR OPLMAXIMUMATTENUATION) - Volume) + Attenuation
977END SUB
978
979FUNCTION ParseBEDWord& (Buffer AS STRING)
980DIM DWord AS LONG
981
982 DWord = ASC(MID$(Buffer, &H4, &H1))
983 DWord = DWord OR (ASC(MID$(Buffer, &H3, &H1)) * &H100&)
984 DWord = DWord OR (ASC(MID$(Buffer, &H2, &H1)) * &H10000)
985 ParseBEDWord& = DWord OR (ASC(MID$(Buffer, &H1, &H1)) * &H1000000)
986END FUNCTION
987
988FUNCTION ParseBEWord (Buffer AS STRING)
989DIM Word
990
991 Word = ASC(MID$(Buffer, &H2, &H1))
992 ParseBEWord = Word OR (ASC(MID$(Buffer, &H1, &H1)) * &H100)
993END FUNCTION
994
995SUB ProcessTrackEvents (MIDI AS MIDIStr, Status AS StatusStr)
996DIM Track
997
998 FOR Track = 0 TO MIDI.TrackCount - 1
999  LoopsBackup(Track).Delay = Tracks(Track).Delay
1000  LoopsBackup(Track).Pointer = Tracks(Track).Pointer
1001  LoopsBackup(Track).Status = Tracks(Track).Status
1002
1003  IF Tracks(Track).Status >= 0 AND Tracks(Track).Delay <= 0 THEN
1004   HandleTrackEvent Track, MIDI, Status
1005   IF Status.LoopEnd THEN
1006
1007    ReturnToLoopStart MIDI, Status
1008
1009    COLOR , 0
1010    CLS
1011    Status.TextRow = 2
1012    DisplayKeys
1013   ELSE
1014    Tracks(Track).Delay = Tracks(Track).Delay + ReadVariableLengthInteger&
1015    Tracks(Track).Pointer = LOC(1)
1016   END IF
1017  END IF
1018 NEXT Track
1019
1020 IF Status.LoopStart THEN
1021  SaveLoopStart MIDI, Status
1022 END IF
1023
1024 DO WHILE ScheduleEventsAfterDelay#(GetShortestDelay&(MIDI.TrackCount), MIDI, Status) < 0
1025 LOOP
1026END SUB
1027
1028SUB Quit ()
1029 PLAY OFF
1030 Display NULL, NULL, 9, "End!"
1031 OPLSilence
1032 CLOSE #1
1033 COLOR 7, 0
1034END SUB
1035
1036FUNCTION ReadVariableLengthInteger& ()
1037DIM Byte
1038DIM VariableLengthInteger AS LONG
1039
1040 VariableLengthInteger = &H0
1041 DO
1042  Byte = ASC(INPUT$(&H1, 1))
1043  VariableLengthInteger = (VariableLengthInteger * &H80) OR (Byte AND &H7F)
1044 LOOP UNTIL Byte < &H80
1045
1046 ReadVariableLengthInteger = VariableLengthInteger
1047END FUNCTION
1048
1049FUNCTION RemoveSpecialCharacters$ (Text AS STRING)
1050DIM Position
1051DIM Result AS STRING
1052
1053 Result = Text
1054 FOR Position = 1 TO LEN(Text)
1055  SELECT CASE MID$(Result, Position, 1)
1056   CASE IS < " ", IS > "~"
1057    MID$(Result, Position, 1) = "?"
1058  END SELECT
1059 NEXT Position
1060
1061 RemoveSpecialCharacters$ = Result
1062END FUNCTION
1063
1064SUB ResetAllControllers (Channel)
1065 ChannelInstruments(Channel).Panning = &H0
1066 ChannelSettings(Channel).Bend = &H0
1067 ChannelSettings(Channel).Vibrato = &H0
1068 UpdateAllLiveNotes Channel, MOPOFF, NULL
1069 UpdateAllLiveNotes Channel, MOPPAN, NULL
1070END SUB
1071
1072SUB ReturnToLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
1073DIM Track AS LONG
1074
1075 FOR Track = 0 TO MIDI.TrackCount - 1
1076  Tracks(Track).Delay = Loops(Track).Delay
1077  Tracks(Track).Pointer = Loops(Track).Pointer
1078  Tracks(Track).Status = Loops(Track).Status
1079 NEXT Track
1080
1081 Status.LoopEnd = FALSE
1082 Status.PlayWait = Status.LoopWait
1083END SUB
1084
1085SUB SaveLoopStart (MIDI AS MIDIStr, Status AS StatusStr)
1086DIM Track AS LONG
1087
1088 FOR Track = 0 TO MIDI.TrackCount - 1
1089  Loops(Track).Delay = LoopsBackup(Track).Delay
1090  Loops(Track).Pointer = LoopsBackup(Track).Pointer
1091  Loops(Track).Status = LoopsBackup(Track).Status
1092 NEXT Track
1093
1094 Status.LoopWait = Status.PlayWait
1095 Status.LoopStart = FALSE
1096END SUB
1097
1098FUNCTION ScheduleEventsAfterDelay# (Delay AS LONG, MIDI AS MIDIStr, Status AS StatusStr)
1099DIM AgeIncrease AS DOUBLE
1100DIM Channel
1101DIM Track
1102 
1103 AgeIncrease = Delay * MIDI.Tempo
1104
1105 FOR Channel = LBOUND(Channels) TO UBOUND(Channels)
1106  Channels(Channel).Age = Channels(Channel).Age + AgeIncrease
1107 NEXT Channel
1108 
1109 FOR Track = 0 TO MIDI.TrackCount - 1
1110  Tracks(Track).Delay = Tracks(Track).Delay - Delay
1111 NEXT Track
1112
1113 IF Status.Began THEN
1114  Status.PlayWait = Status.PlayWait + AgeIncrease
1115 END IF
1116 
1117 ScheduleEventsAfterDelay# = AgeIncrease
1118END FUNCTION
1119
1120SUB UpdateAllLiveNotes (Channel, MIDIOperation, Volume)
1121DIM ActiveChannel
1122DIM ActiveCount
1123DIM ActiveNote
1124DIM Note
1125
1126 ActiveCount = ActiveNoteCount(Channel)
1127
1128 FOR ActiveNote = 1 TO ActiveCount
1129  Note = ActiveNoteList(Channel, ActiveNote)
1130  ActiveChannel = ActiveNote(Channel, Note).AdlibChannel
1131  SELECT CASE MIDIOperation
1132   CASE MOPOFF
1133    DeallocateActiveNote Channel, ActiveNote
1134   CASE MOPPAN
1135    UpdateNotePan ActiveChannel, Channel
1136   CASE MOPPITCH
1137    OPLNoteOn ActiveChannel, GetHertz#(ActiveNote(Channel, Note).Note, ChannelSettings(Channel).Bend)
1138   CASE MOPPRESSURE
1139    ActiveNote(Channel, Note).Volume = Volume
1140    UpdateNoteVolume ActiveChannel, Channel, ActiveNote(Channel, Note).Volume
1141   CASE MOPVOLUME
1142    UpdateNoteVolume ActiveChannel, Channel, ActiveNote(Channel, Note).Volume
1143  END SELECT
1144 NEXT ActiveNote
1145END SUB
1146
1147SUB UpdateNotePan (ActiveChannel, Channel)
1148DIM OPL AS OPLStr
1149
1150 ChannelInstruments(ActiveChannel).Panning = ChannelSettings(Channel).Panning
1151 OPLSetUp ActiveChannel, OPL
1152 OUT OPL.Index, &HC0 + OPL.SubChannel
1153 OUT OPL.DataV, Instruments(ChannelInstruments(ActiveChannel).Instrument, 5) - ChannelInstruments(ActiveChannel).Panning
1154END SUB
1155
1156SUB UpdateNoteVolume (ActiveChannel, Channel, Volume)
1157 IF Volume = &H0 THEN
1158  OPLTouchReal ActiveChannel, &H0
1159 ELSE
1160  OPLTouchReal ActiveChannel, (LOG((Volume * ChannelSettings(Channel).Volume) / &H3F01) * &H8) + &H3F
1161 END IF
1162END SUB

My GitHub:
https://github.com/peterswinkels

Go to top of page Go to top of page

Back to DOSBox General