'(C) 1997 BriTech International / Hamster Republic Productions
'$DYNAMIC
DEFINT A-Z
'Basic Sub
DECLARE SUB setinstused (bamuse(), song(), songl)
DECLARE SUB playnote (chan, note, id)
DECLARE SUB stopnote (chan)
DECLARE SUB domidikeyb (ibank$)
DECLARE SUB playtick ()
DECLARE SUB drawkey (i, p, x(), which(), pag)
DECLARE SUB getfour (f, p&, v&)
DECLARE SUB sortstrings (st$(), num)
DECLARE SUB getdir (path$, fmask$, dl(), numd, files$(), dirs$(), fmatch, dmatch)
DECLARE SUB writedelay ()
DECLARE SUB stopplay ()
DECLARE SUB setins (ins, ibank$)
DECLARE SUB newsong ()
DECLARE SUB savebam (sname$, fpath$)
DECLARE SUB saveb2minfo (saven$, channels, chanminst(), chaninst(), voicvel())
DECLARE SUB getb2minfo (saven$, channels, chanminst(), chaninst(), voicvel())
DECLARE FUNCTION justname$ (f$)
'General Mode-X Stuff
DECLARE SUB setmodex ()
DECLARE SUB restoremode
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB clearpage (BYVAL page)
'Page stuff
DECLARE SUB setdiskpages (buf(), BYVAL l, BYVAL b)
DECLARE SUB storepage (fil$, BYVAL i, BYVAL p)
DECLARE SUB loadpage (fil$, BYVAL i, BYVAL p)
'Mode-X Boxes N Pixels
DECLARE SUB rectangle (BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL c, BYVAL p)
DECLARE SUB putpixel (BYVAL x, BYVAL y, BYVAL c, BYVAL p)
DECLARE FUNCTION readpixel (BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB drawline (BYVAL x1, BYVAL y1, BYVAL x2, BYVAL y2, BYVAL c, BYVAL p)
'Palette stuff
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
'Mode-X Text
DECLARE SUB setfont (f())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL f, BYVAL b)
'Spiffo Timing
DECLARE SUB setwait (b(), BYVAL t)
DECLARE SUB dowait ()
'Adlib musica
DECLARE SUB setupmusic (b())
DECLARE SUB closemusic ()
DECLARE SUB resetfm ()
DECLARE SUB fmkeyon (BYVAL v, BYVAL n)
DECLARE SUB fmkeyoff (BYVAL v)
DECLARE SUB getvoice (BYVAL v, BYVAL io, f$, b())
DECLARE SUB setvoice (BYVAL v, b())
DECLARE FUNCTION getfmvol ()
DECLARE SUB setfmvol (BYVAL vol)
'Keyhandling
DECLARE SUB setkeys ()
DECLARE FUNCTION Keyseg ()
DECLARE FUNCTION keyoff ()
DECLARE FUNCTION keyval (BYVAL a)
DECLARE FUNCTION getkey ()
'filestuf
DECLARE SUB findfiles (n$, BYVAL m, o$, b())
DECLARE SUB getstring (p$)
DECLARE FUNCTION envlength (e$)
DECLARE FUNCTION pathlength ()
DECLARE FUNCTION rpathlength ()
DECLARE FUNCTION drivelist (d())
DECLARE SUB setdrive (BYVAL n)
DECLARE FUNCTION isfile (n$)
'binary io
DECLARE SUB setendian (BYVAL e)
DECLARE FUNCTION openbin (f$)
DECLARE SUB closebin (BYVAL f)
DECLARE FUNCTION readbyte (BYVAL h, BYVAL p&)
DECLARE SUB writebyte (BYVAL h, BYVAL p&, BYVAL b)
DECLARE FUNCTION readword (BYVAL h, BYVAL p&)
DECLARE SUB writeword (BYVAL h, BYVAL p&, BYVAL w)
DECLARE FUNCTION readdword& (BYVAL h, BYVAL p&)
DECLARE SUB writedword (BYVAL h, BYVAL p&, BYVAL d&)
DECLARE SUB readstring (BYVAL h, BYVAL p&, s$)
DECLARE SUB writestring (BYVAL h, BYVAL p&, s$)
DECLARE SUB readarray (BYVAL h, BYVAL p&, a(), BYVAL s, BYVAL b)
DECLARE SUB writearray (BYVAL h, BYVAL p&, a(), BYVAL s, BYVAL b)
DECLARE FUNCTION readpointer& (BYVAL h)
DECLARE SUB setpointer (BYVAL h, BYVAL p&)
'midi keyboard
DECLARE FUNCTION set2midi (BYVAL b)
DECLARE FUNCTION readmidi (m())
TYPE Regtype
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
DIM SHARED regs AS Regtype
regs.ax = &H3509: CALL interruptx(&H21, regs, regs)
off9 = regs.bx: seg9 = regs.es
DIM SHARED font(1024), master(800), buf(16384), timing(1), mouse(4)
DIM SHARED inst$(127), note(9), value(9), x(12), which(12)
DIM SHARED keyon(127), keymap(127), skey$(55), keyboard(65)
DIM SHARED song(16000), rec(16000), tagp(16), rep(16), inst(6), time&(16)
DIM SHARED bamuse(15), vinst(15, 6)
DIM SHARED mkeymap(127)
DIM dirs$(256), bam$(512)
DIM dl(27)
DIM dispx(15), dispn(15)
DIM midc(15), midi(15), midn(15)
DIM mtrk&(15), mtrkd&(15), mtrkl&(15), mtrks&(15), mtrke(15), mtrkend(15), mtrki(15)
DIM offn(32), offc(32), offs(32), onn(32), onc(32)

DIM chann$(19), chaninst(19, 6), chanminst(19)
DIM voicchan(15), voicvel(15), noteplay(15), ctagp(16), crep(16)
DIM cnoteon(127)

DIM metx(8), mety(8)

DIM SHARED playsong, songl, songp, recsong, recp, recd, retp, waitt, progdir$, inst, bamlook, dpage

midistep = 24
CONST notater = 0
CONST instrument = 1
CONST saving = 2
CONST savmidi = 10
CONST loading = 3
CONST setkeymap = 4
CONST lowk = 0, highk = 8


benv$ = STRING$(envlength("BLASTER"), 0)
getstring benv$
IF benv$ = "" THEN
 sbp = 544
ELSE
 FOR i = 1 TO LEN(benv$)
  IF MID$(benv$, i, 1) = "A" THEN
   i = i + 1
   sbp = 0
   WHILE MID$(benv$, i, 1) <> " "
    sbp = sbp * 16 + VAL(MID$(benv$, i, 1))
    i = i + 1
   WEND
  END IF
 NEXT i
END IF

IF set2midi(sbp) = 1 THEN midikeyb = 1

numd = drivelist(dl())
songl = 0: recl = 0
songp = 0: recp = 0
playsong = 0
setdiskpages buf(), 200, 0
inst = 0
fadeto buf(), 0, 0, 0
setmodex
setpal master()
oldfm = getfmvol
fmvol = 15
path$ = STRING$(pathlength, 0)
getstring path$
progdir$ = STRING$(rpathlength, 0)
getstring progdir$
IF RIGHT$(progdir$, 5) = "QB45\" THEN progdir$ = ""
DEF SEG = VARSEG(mkeymap(0))
BLOAD progdir$ + "caskeyb.map", VARPTR(mkeymap(0))
fmask$ = "*.bam" + CHR$(0)
getdir path$, fmask$, dl(), numd, bam$(), dirs$(), fmatch, dmatch
fpoint = 0: fstart = 0: dpoint = 0: dstart = 0: resetfm
RESTORE keymapping
FOR i = 2 TO 53
 READ skey$(i)
NEXT i
RESTORE keydata
FOR i = 0 TO 11
 READ x(i), which(i)
NEXT i
ibank$ = progdir$ + "gm.ibk"
OPEN ibank$ FOR BINARY AS #1
FOR i = 0 TO 127
 inst$(i) = STRING$(9, 0)
 GET #1, 2053 + i * 9, inst$(i)
NEXT i
CLOSE #1
DEF SEG = VARSEG(font(0)): BLOAD progdir$ + "piano.fnt", VARPTR(font(0))
setfont font()
DEF SEG = VARSEG(master(0)): BLOAD progdir$ + "palette.sto", VARPTR(master(0))
GOSUB switchon
RANDOMIZE TIMER
vpage = 0: dpage = 1: delay = 56
showkeys = 0
setfmvol fmvol
GOSUB setdefault
setins inst, ibank$

FOR i = 29 TO 95
 drawkey i, 0, x(), which(), 2
NEXT i
textcolor 15, 1
FOR i = 0 TO 9
 j = i * 3
 printstr CHR$(128 + j) + CHR$(129 + j) + CHR$(130 + j), 4 + i * 32, 192, 2
NEXT i

loadpage progdir$ + "piano.pic" + CHR$(0), 0, 0
setvispage 0
fadetopal master(), buf()

met = 1
RESTORE metronome
FOR i = 0 TO 8
 READ metx(i), mety(i)
NEXT i

w = getkey
setkeys
exitprog = 0
WHILE exitprog = 0
setwait timing(), delay
copypage 2, dpage
setkeys
IF recsong THEN
 recd = recd + 1: IF recd = 128 THEN writedelay
 textcolor 14, 4: printstr "REC", 30, 180, dpage
END IF
IF keyval(1) > 1 THEN IF bamlook <> notater THEN bamlook = notater ELSE exitprog = 1
IF bamlook = 0 THEN
 IF keyval(72) > 1 AND inst > 0 THEN inst = inst - 1: setins inst, ibank$
 IF keyval(80) > 1 AND inst < 127 THEN inst = inst + 1: setins inst, ibank$
END IF
IF keyval(74) > 1 AND fmvol > 1 THEN fmvol = fmvol - 1: setfmvol fmvol
IF keyval(78) > 1 AND fmvol < 15 THEN fmvol = fmvol + 1: setfmvol fmvol
IF keyval(62) > 1 THEN newsong: setins inst, ibank$
IF keyval(66) > 1 THEN showkeys = showkeys XOR 1
IF keyval(65) > 1 THEN IF recsong = 1 THEN GOSUB transfer: recsong = 0 ELSE recsong = 1: recp = 0: recl = 0: recd = 0
IF keyval(63) > 1 THEN IF playsong = 1 THEN playsong = 0: stopplay ELSE playsong = 1
IF keyval(61) > 1 AND bamlook = notater THEN
 IF keyval(42) > 0 OR keyval(54) > 0 THEN fmask$ = "*.mid" + CHR$(0) ELSE fmask$ = "*.bam" + CHR$(0)
 getdir path$, fmask$, dl(), numd, bam$(), dirs$(), fmatch, dmatch
 fpoint = 0: fstart = 0: dpoint = 0: dstart = 0
 bamlook = loading: filefocus = 0
END IF
IF keyval(60) > 1 AND bamlook = notater THEN
 saven$ = curn$
 IF keyval(42) > 0 OR keyval(54) > 0 THEN
  GOSUB evalbam
  bamlook = savmidi
 ELSE
  bamlook = saving
 END IF
END IF

IF playsong = 1 AND songl > 0 THEN
 textcolor 14, 4
 printstr "PLAY", 62, 180, dpage
 playtick
END IF

IF met > 0 THEN
 met = met + 1: IF met > 16 THEN met = 1
 j = ABS(met - 8)
 drawline 200 + metx(j), 170 + mety(j), 200, 170, 15, dpage
 drawline 200 + metx(j), 170 + mety(j), 200, 170, 15, dpage
END IF

IF bamlook = loading THEN GOSUB findbam
IF bamlook = saving THEN savebam saven$, fpath$
IF bamlook = savmidi THEN GOSUB savemidi
IF bamlook = notater THEN GOSUB notation

IF midikeyb = 1 THEN
 domidikeyb (ibank$)
END IF

IF nokeypress = 0 THEN
 FOR i = 29 TO 95
  IF showkeys <> 0 AND keymap(i) > 0 AND keymap(i) <= 55 AND keyon(i) = 0 THEN
   oct = INT(i / 12)
   koff = i - oct * 12
   IF which(koff) < 3 THEN
    textcolor 4, 0
    printstr skey$(keymap(i)), x(koff) + 56 * (oct - 2) - 19, 108, dpage
   ELSE
    textcolor 5, 0
    printstr skey$(keymap(i)), x(koff) + 56 * (oct - 2) - 20, 80, dpage
   END IF
  END IF
  IF (keyval(keymap(i)) AND 2) = 2 AND keymap(i) > 0 AND keyon(i) = 0 THEN
   j = lowk
   WHILE j <= highk AND (value(j) <> 0 OR bamuse(j) = 1)
    j = j + 1
   WEND
   IF j <= highk THEN
    playnote j, i, keymap(i)
    keyon(i) = 1
   END IF
  END IF
 NEXT i
END IF
nokeypress = 0

FOR i = 0 TO 8
 IF value(i) < 0 THEN
  IF note(i) > 28 AND note(i) < 96 THEN drawkey note(i), 2, x(), which(), dpage
 END IF
 IF value(i) > 0 THEN
  IF keyval(value(i)) = 0 THEN
   stopnote i
   keyon(note(i)) = 0
  ELSE
   drawkey note(i), 1, x(), which(), dpage
  END IF
 END IF
NEXT i

FOR i = 1 TO fmvol
 rectangle 290, 170 - 3 * i, 10, 2, 10, dpage
NEXT i
textcolor 15, 8: printstr "VOL", 284, 170, dpage
textcolor 15, 9: printstr inst$(inst), 30, 148, dpage
textcolor 7, 1
IF inst > 0 THEN printstr inst$(inst - 1), 30, 140, dpage
IF inst < 127 THEN printstr inst$(inst + 1), 30, 156, dpage
SWAP vpage, dpage
setvispage vpage
dowait
WEND
GOTO quit

notation:
GOSUB display
IF keyval(77) > 0 AND songl > 0 THEN
 IF playsong = 1 THEN playtick ELSE GOSUB moveforward
END IF
IF keyval(75) > 0 THEN GOSUB moveback
IF keyval(73) > 1 THEN GOSUB moveforward
IF keyval(81) > 1 THEN GOSUB moveback
RETURN

moveforward:
IF waitt > 0 THEN waitt = waitt - 1
WHILE waitt = 0
 IF songp > songl THEN songp = 0
 i = song(songp)
 temp = INT(i / 16)
 songp = songp + 1
 SELECT CASE temp
  CASE 0
   songp = 0
   waitt = 1
  CASE 1
   songp = songp + 1
  CASE 2
  CASE 3
   songp = songp + 6
  CASE 5
   i = i AND 15
   tagp(i) = songp
  CASE 6
   i = i AND 15
   j = song(songp)
   songp = songp + 1
   IF j = 255 THEN retp = songp: songp = tagp(i)
   IF j = 254 THEN songp = tagp(i)
   IF j < 254 THEN
    IF rep(i) = 1 THEN
     rep(i) = 0
    ELSEIF rep(i) = 0 THEN
     rep(i) = j
     songp = tagp(i)
    ELSE
     rep(i) = rep(i) - 1
     songp = tagp(i)
    END IF
   END IF
  CASE 7
   IF retp <> 0 THEN songp = retp: retp = 0
  CASE IS > 7
   waitt = (i AND 127) + 1
 END SELECT
WEND
RETURN

moveback:
RETURN

evalbam:
 saven$ = justname$(saven$) + ".mid"
 testchan = 0
 whichchan = -1
 i = 0
 channels = 0
 textcolor 12, 1
 setinstused bamuse(), song(), songl
 WHILE i < songl
  j = song(i)
  k = j AND 15
  j = INT(j / 16)
  i = i + 1
  SELECT CASE j
  CASE 0
   i = songl
  CASE 1
   i = i + 1
  CASE 2
  CASE 3
   IF bamuse(k) <> 0 THEN
    textcolor 14, 1
    FOR l = 0 TO 5
     chaninst(channels, l) = song(i + l)
    NEXT l
    match = -1
    FOR k = 0 TO channels - 1
     temp = 0
     FOR l = 0 TO 4
      IF chaninst(k, l) <> chaninst(channels, l) THEN temp = 1
     NEXT l
     IF temp = 0 THEN match = k
    NEXT k
    IF match = -1 OR channels = 0 THEN
     tempins = 0
     FOR k = 0 TO 127
      temp = 0
      getvoice 0, k, ibank$ + CHR$(0), inst()
      FOR l = 0 TO 4
       IF chaninst(channels, l) <> inst(l) THEN temp = 1
      NEXT l
      IF temp = 0 THEN tempins = k
     NEXT k
     chanminst(channels) = tempins
     voicvel(channels) = 100
     channels = channels + 1
    END IF
   END IF
   i = i + 6
  CASE 5
  CASE 6
   j = song(i)
   i = i + 1
   IF j = 255 THEN i = songl
  CASE 7
  CASE IS > 7
  END SELECT
 WEND
 getb2minfo saven$, channels, chanminst(), chaninst(), voicvel()
RETURN

savemidi:
IF keyval(72) > 1 AND whichchan > -1 THEN whichchan = whichchan - 1
IF keyval(80) > 1 AND whichchan < channels - 1 THEN whichchan = whichchan + 1
IF whichchan = -1 THEN textcolor 14, 1 ELSE textcolor 7, 1
printstr saven$, 100, 5, dpage
FOR i = 0 TO channels - 1
 IF whichchan = i THEN textcolor 14, 1 ELSE textcolor 7, 1
 printstr inst$(chanminst(i)) + " volume:" + STR$(voicvel(i)), 100, 13 + 8 * i, dpage
NEXT i
SELECT CASE whichchan
CASE IS > -1
 inst = chanminst(whichchan)
 IF keyval(73) > 1 THEN
  getvoice 1, chanminst(whichchan), ibank$ + CHR$(0), inst()
  fmkeyon 1, 52
  playstop! = TIMER + .25
 END IF
 IF keyval(81) > 1 THEN
  FOR i = 0 TO 5
   inst(i) = chaninst(whichchan, i)
  NEXT i
  setvoice 1, inst()
  fmkeyon 1, 52
  playstop! = TIMER + .25
 END IF
 IF TIMER > playstop! AND playstop! > 0 THEN
  fmkeyoff 1
  playstop! = 0
 END IF
 IF keyval(77) > 1 AND chanminst(whichchan) < 127 THEN
  chanminst(whichchan) = chanminst(whichchan) + 1
 END IF
 IF keyval(75) > 1 AND chanminst(whichchan) > 0 THEN
  chanminst(whichchan) = chanminst(whichchan) - 1
 END IF
 IF (keyval(78) > 1 OR keyval(13) > 1) AND voicvel(whichchan) < 125 THEN
  voicvel(whichchan) = voicvel(whichchan) + 5
 END IF
 IF (keyval(74) > 1 OR keyval(12) > 1) AND voicvel(whichchan) > 5 THEN
  voicvel(whichchan) = voicvel(whichchan) - 5
 END IF
CASE -1
 IF keyval(0) = 14 THEN
  IF LEN(saven$) > 0 THEN saven$ = LEFT$(saven$, LEN(saven$) - 1)
 ELSEIF keyval(0) < 54 AND keyval(0) <> 28 THEN
  IF LEN(saven$) < 12 AND skey$(keyval(0)) <> " " THEN saven$ = saven$ + skey$(keyval(0))
 ELSEIF keyval(0) = 28 AND saven$ <> "" THEN
  saveb2minfo saven$, channels, chanminst(), chaninst(), voicvel()
  i = 1
  WHILE i < LEN(saven$) AND MID$(saven$, i, 1) <> "."
   i = i + 1
  WEND
  IF MID$(saven$, i, 1) <> "." THEN saven$ = saven$ + ".mid"
  handl = openbin(fpat$ + saven$ + CHR$(0))
  IF handl <> -1 THEN
   setendian 1
   writestring handl, -1, "MThd"
   writedword handl, -1, 6
   writeword handl, -1, 1
   writeword handl, -1, channels + 1
   writeword handl, -1, 80
   writestring handl, -1, "MTrk"
   writedword handl, -1, 19
   writebyte handl, -1, 0
   writebyte handl, -1, 255
   writebyte handl, -1, 88
   writebyte handl, -1, 4
   writebyte handl, -1, 4
   writebyte handl, -1, 2
   writebyte handl, -1, 24
   writebyte handl, -1, 8
   writebyte handl, -1, 0
   writebyte handl, -1, 255
   writebyte handl, -1, 81
   writebyte handl, -1, 3
   writebyte handl, -1, 6
   writebyte handl, -1, 181
   writebyte handl, -1, 8
   writebyte handl, -1, 0
   writebyte handl, -1, 255
   writebyte handl, -1, 47
   writebyte handl, -1, 0
   FOR i = 0 TO channels - 1
    FOR k = 0 TO 9
     voicchan(k) = -1
     noteplay(k) = 0
    NEXT k
    FOR k = 0 TO 127
     cnoteon(k) = 0
    NEXT k
    writestring handl, -1, "MTrk"
    tstart& = readpointer(handl) + 4
    setpointer handl, tstart&
    IF i >= 9 THEN midchan = i + 1 ELSE midchan = i
    writebyte handl, -1, 0
    writebyte handl, -1, midchan + 12 * 16
    writebyte handl, -1, chanminst(i)
    j = 0
    didchannel = 0
    cretp = 0
    cdelay& = 0
    WHILE didchannel = 0
     k = song(j)
     temp = INT(k / 16)
     j = j + 1
     SELECT CASE temp
     CASE 0
      didchannel = 1
     CASE 1
      l = song(j)
      j = j + 1
      k = k AND 15
      IF k < 9 THEN
       IF voicchan(k) = i AND cnoteon(l) = 0 THEN
        noteplay(k) = l
        cnoteon(l) = 1
        GOSUB writemididelay
        writebyte handl, -1, midchan + 9 * 16
        writebyte handl, -1, noteplay(k)
        writebyte handl, -1, voicvel(i)
       END IF
      END IF
     CASE 2
      k = k AND 15
      IF k < 9 THEN
       IF voicchan(k) = i AND cnoteon(noteplay(k)) > 0 THEN
        GOSUB writemididelay
        writebyte handl, -1, midchan + 8 * 16
        writebyte handl, -1, noteplay(k)
        writebyte handl, -1, voicvel(i)
        cnoteon(noteplay(k)) = 0
       END IF
       noteplay(k) = 0
      END IF
     CASE 3
      k = k AND 15
      IF k < 9 THEN
       match = 1
       FOR l = 0 TO 4
        IF chaninst(i, l) <> song(j + l) THEN match = 0
       NEXT l
       IF match = 1 THEN
        voicchan(k) = i
       ELSE
        voicchan(k) = -1
       END IF
      END IF
      j = j + 6
     CASE 4
     CASE 5
      k = k AND 15
      ctagp(k) = j
     CASE 6
      k = k AND 15
      l = song(j)
      j = j + 1
      IF l = 255 THEN cretp = j: j = ctagp(k)
      IF l = 254 THEN didchannel = 1
      IF l < 254 THEN
       IF crep(k) = 1 THEN
        crep(k) = 0
       ELSEIF crep(k) = 0 THEN
        crep(k) = l
        j = ctagp(k)
       ELSE
        crep(k) = crep(k) - 1
        j = ctagp(k)
       END IF
      END IF
     CASE 7
      IF cretp <> 0 THEN j = cretp: cretp = 0
     CASE IS > 7
      l = (k AND 127) + 1
      cdelay& = cdelay& + l * 10
     END SELECT
    WEND
    didchannel = 0
    FOR k = 0 TO 127
     IF cnoteon(k) > 0 THEN
      GOSUB writemididelay
      writebyte handl, -1, midchan + 8 * 16
      writebyte handl, -1, k
      writebyte handl, -1, voicvel(i)
      cnoteon(k) = 0
     END IF
    NEXT k
    GOSUB writemididelay
    writebyte handl, -1, 255
    writebyte handl, -1, 47
    writebyte handl, -1, 0
    tend& = readpointer(handl)
    writedword handl, tstart& - 4, tend& - tstart&
    setpointer handl, tend&
   NEXT i
   closebin handl
  END IF
  bamlook = 0
 END IF
END SELECT
RETURN

writemididelay:
FOR temp2 = 21 TO 7 STEP -7
 temp3& = 2 ^ temp2
 IF cdelay& >= temp3& THEN
  writebyte handl, -1, 128 + (127 AND INT(cdelay& / temp3&))
  cdelay& = cdelay& AND (temp3& - 1)
 END IF
NEXT temp2
writebyte handl, -1, 127 AND cdelay&
cdelay& = 0
RETURN

findbam:
temp = 0
rectangle 7, 9, 202, 58, 9, dpage
rectangle 8, 10, 200, 56, 1, dpage
rectangle 7, 69, 306, 10, 9, dpage
rectangle 8, 70, 304, 8, 1, dpage
rectangle 215, 11, 98, 50, 9, dpage
rectangle 216, 12, 96, 48, 1, dpage
textcolor 14, 1: printstr RIGHT$(path$, 38), 8, 70, dpage
WHILE temp + fstart < fmatch AND temp < 14
 IF temp + fstart = fpoint AND filefocus = 0 THEN textcolor 14, 9 ELSE textcolor 15, 1
 printstr bam$(temp + fstart), 8 + 104 * (temp AND 1), 10 + INT(temp / 2) * 8, dpage
 temp = temp + 1
WEND
temp = 0
WHILE temp + dstart < dmatch AND temp < 6
 IF temp + dstart = dpoint AND filefocus = 1 THEN textcolor 14, 9 ELSE textcolor 15, 1
 printstr dirs$(temp + dstart), 216, temp * 8 + 12, dpage
 temp = temp + 1
WEND
IF fmatch = 0 THEN filefocus = 1
IF filefocus = 0 THEN
 IF keyval(15) > 1 THEN filefocus = 1
 IF keyval(75) > 1 OR keyval(77) > 1 THEN fpoint = fpoint XOR 1
 IF keyval(72) > 1 AND fpoint > 1 THEN
  fpoint = fpoint - 2
  IF fpoint < fstart THEN fstart = fpoint AND (NOT 1)
 END IF
 IF keyval(80) > 1 THEN
  fpoint = fpoint + 2
  IF fpoint >= fmatch THEN fpoint = fmatch - 1
  IF fpoint - fstart > 13 THEN fstart = fstart + 2
 END IF
 IF keyval(28) > 1 THEN fpat$ = path$: songn$ = path$ + bam$(fpoint): curn$ = bam$(fpoint): GOSUB loadsong: bamlook = notater
ELSE
 IF keyval(75) > 1 OR keyval(77) > 1 OR keyval(15) > 1 THEN filefocus = 0
 IF keyval(72) > 1 AND dpoint > 0 THEN
  dpoint = dpoint - 1
  IF dpoint < dstart THEN dstart = dpoint
 END IF
 IF keyval(80) > 1 THEN
  dpoint = dpoint + 1
  IF dpoint >= dmatch THEN dpoint = dmatch - 1
  IF dpoint - dstart > 5 THEN dstart = dstart + 1
 END IF
 IF keyval(28) > 1 THEN
  IF dpoint >= dmatch - numd THEN
   setdrive dl(dpoint - dmatch + numd)
   path$ = STRING$(pathlength, 0)
   getstring path$
  ELSEIF dirs$(dpoint) = ".." THEN
   IF LEN(path$) > 0 THEN
    IF MID$(path$, LEN(path$) - 2, 1) = "." THEN
     path$ = path$ + dirs$(dpoint) + "\"
    ELSE
     temp = LEN(path$) - 1
     WHILE MID$(path$, temp, 1) <> "\"
      temp = temp - 1
     WEND
     path$ = LEFT$(path$, temp)
    END IF
   ELSE
    path$ = path$ + dirs$(dpoint) + "\"
   END IF
  ELSE
   path$ = path$ + dirs$(dpoint) + "\"
  END IF
  getdir path$, fmask$, dl(), numd, bam$(), dirs$(), fmatch, dmatch
  fpoint = 0: fstart = 0: dpoint = 0: dstart = 0
  filefocus = 0
 END IF
END IF
RETURN

loadsong:
OPEN songn$ FOR BINARY AS #1
tag$ = "CBMF"
GET #1, 1, tag$
IF tag$ = "CBMF" THEN
 newsong
 setins inst, ibank$
 ptr = 5
 bytes = 0
 waitt = 0
 WHILE EOF(1) = 0
  GET #1, ptr, temp
  ptr = ptr + 1
  IF temp < 0 THEN temp = 32768 + temp
  temp = temp AND 255
  song(songl) = temp
  songl = songl + 1
  IF bytes = 0 THEN
   IF (temp AND 240) = 16 THEN bytes = 1
   IF (temp AND 240) = 48 THEN
    FOR i = 1 TO 6
     GET #1, ptr, j
     song(songl) = j
     songl = songl + 1
     ptr = ptr + 2
    NEXT i
    ptr = ptr - 1
   END IF
   IF (temp AND 240) = 96 THEN bytes = 1
  ELSE
   bytes = bytes - 1
  END IF
 WEND
ELSEIF tag$ = "MThd" THEN
 newsong
 setins inst, ibank$
 FOR i = 0 TO 15
  midc(i) = -1:  midi(i) = -1: midn(i) = -1: mtrk&(i) = 1: mtrkd&(i) = 4000000: mtrkend(i) = -1: mtrki(i) = 1
 NEXT i
 getfour 1, 5, pntr&
 pntr& = pntr& + 9
 GET #1, 12, tracks
 tag$ = "MTrk"
 i = 0
 IF tracks > 15 THEN tracks = 15
 WHILE i < tracks AND tag$ = "MTrk"
  GET #1, pntr&, tag$
  pntr& = pntr& + 4
  getfour 1, pntr&, mtrkl&(i)
  pntr& = pntr& + 4
  mtrk&(i) = pntr&
  mtrks&(i) = pntr&
  pntr& = pntr& + mtrkl&(i)
  mtrkd&(i) = 0
  delay& = 0
  DO
   delay& = delay& * 128
   GET #1, mtrk&(i), temp
   mtrk&(i) = mtrk&(i) + 1
   IF temp < 0 THEN temp = 32768 + temp
   temp = temp AND 255
   delay& = delay& + (temp AND 127)
  LOOP UNTIL (temp AND 128) = 0 OR (delay& > 1600000)
  mtrkd&(i) = delay&
  i = i + 1
 WEND
 tracks = i
 j = 0
 nextv = 0
 lastd& = 0
 midid& = 0
 WHILE j < tracks AND songl < 15950
 noff = 0: non = 0
 FOR i = 0 TO tracks - 1
  WHILE mtrkd&(i) <= midid& AND mtrkend(i) < 2 AND songl < 15950
   setkeys
   IF keyval(1) > 1 THEN mtrkend(i) = 2: j = tracks: setkeys
   GET #1, mtrk&(i), temp
   IF temp < 0 THEN temp = 32768 + temp
   temp = temp AND 255
   IF (temp AND 128) = 128 THEN
    mtrk&(i) = mtrk&(i) + 1
    mtrke(i) = temp
   END IF
   SELECT CASE INT(mtrke(i) / 16)
    CASE 8
     channel = mtrke(i) AND 15
     IF channel <> 9 THEN
      GET #1, mtrk&(i), temp
      IF temp < 0 THEN temp = 32768 + temp
      temp = temp AND 127
      offn(noff) = temp: offc(noff) = channel: offs(noff) = 0
      noff = noff + 1
     END IF
     mtrk&(i) = mtrk&(i) + 2
    CASE 9
     channel = mtrke(i) AND 15
     IF channel <> 9 THEN
      GET #1, mtrk&(i) + 1, temp
      IF temp < 0 THEN temp = 32768 + temp
      temp = temp AND 127
      IF temp = 0 THEN
       GET #1, mtrk&(i), temp
       IF temp < 0 THEN temp = 32768 + temp
       temp = temp AND 127
       offn(noff) = temp: offc(noff) = channel: offs(noff) = 0
       noff = noff + 1
      ELSE
       GET #1, mtrk&(i), temp
       IF temp < 0 THEN temp = 32768 + temp
       temp = temp AND 127
       onc(non) = channel: onn(non) = temp
       non = non + 1
      END IF
     END IF
     mtrk&(i) = mtrk&(i) + 2
    CASE 10
     mtrk&(i) = mtrk&(i) + 2
    CASE 11
     mtrk&(i) = mtrk&(i) + 2
    CASE 12
     channel = mtrke(i) AND 15
     IF channel <> 9 THEN
      GET #1, mtrk&(i), temp
      IF temp < 0 THEN temp = 32768 + temp
      temp = temp AND 127
      mtrki(channel) = temp
     END IF
     mtrk&(i) = mtrk&(i) + 1
    CASE 13
     mtrk&(i) = mtrk&(i) + 1
    CASE 14
     mtrk&(i) = mtrk&(i) + 2
    CASE 15
     mtrk&(i) = mtrk&(i) + 1
     GET #1, mtrk&(i), temp
     IF temp < 0 THEN temp = 32768 + temp
     temp = temp AND 255
     mtrk&(i) = mtrk&(i) + temp + 1
    CASE ELSE
     mtrk&(i) = mtrk&(i) + 1
     mtrkd&(i) = 1
   END SELECT
   IF mtrk&(i) - mtrks&(i) >= mtrkl&(i) THEN mtrk&(i) = mtrks&(i): IF mtrkend(i) = 0 THEN mtrkend(i) = 1: j = j + 1 ELSE IF mtrkend(i) = -1 THEN mtrkend(i) = 2: j = j + 1
   delay& = 0
   DO
    delay& = delay& * 128
    GET #1, mtrk&(i), temp
    mtrk&(i) = mtrk&(i) + 1
    IF temp < 0 THEN temp = 32768 + temp
    temp = temp AND 255
    delay& = delay& + (temp AND 127)
   LOOP UNTIL (temp AND 128) = 0 OR delay& > 1600000
   mtrkd&(i) = delay& + mtrkd&(i)
  WEND
  IF mtrkend(i) = -1 THEN mtrkend(i) = 0
 NEXT i
'       TURN OFF VOICES
 FOR i = 0 TO noff - 1
  voic = 0
  WHILE (midn(voic) <> offn(i) OR midc(voic) <> offc(i)) AND voic < 9
   voic = voic + 1
  WEND
  IF voic > 8 THEN
   offs(i) = 1
  ELSE
   midn(voic) = -1
   GOSUB mididelay
   song(songl) = 2 * 16 + voic
   songl = songl + 1
  END IF
 NEXT i
'       TURN ON VOICES
 FOR i = 0 TO non - 1
  voic = 0
  WHILE (midi(voic) <> mtrki(onc(i)) OR midn(voic) > -1) AND voic < 9
   voic = voic + 1
  WEND
  IF voic > 8 THEN
   voic = 0
   WHILE (midn(voic) > -1 OR midi(voic) > -1) AND voic < 9
    voic = voic + 1
   WEND
   IF voic > 8 THEN
    voic = 0
    WHILE midn(voic) > -1 AND voic < 9
     voic = voic + 1
    WEND
   END IF
   IF voic < 9 THEN
    bamuse(voic) = 1
    midi(voic) = mtrki(onc(i))
    GOSUB mididelay
    getvoice 0, midi(voic), ibank$ + CHR$(0), inst()
    song(songl) = voic + 48
    songl = songl + 1
    FOR temp2 = 0 TO 5
     song(songl) = inst(temp2)
     songl = songl + 1
    NEXT temp2
   END IF
  END IF
  IF voic < 9 THEN
   GOSUB mididelay
   midn(voic) = onn(i)
   midc(voic) = onc(i)
   song(songl) = 16 + voic
   song(songl + 1) = onn(i)
   songl = songl + 2
  END IF
 NEXT i
'       ADVANCE DELAY
 midid& = midid& + midistep
'       TURN OFF DELAYED STOPS
 FOR i = 0 TO noff - 1
  IF offs(i) = 1 THEN
   voic = 0
   WHILE (midn(voic) <> offn(i) OR midc(voic) <> offc(i)) AND voic < 9
    voic = voic + 1
   WEND
   IF voic < 9 THEN
    midn(voic) = -1
    GOSUB mididelay
    song(songl) = 2 * 16 + voic
    songl = songl + 1
   END IF
  END IF
 NEXT i
' textcolor 14, 1: printstr STR$(songl), 140, 100, vpage
 WEND
END IF
CLOSE #1
setinstused bamuse(), song(), songl
setins inst, ibank$
RETURN

mididelay:
IF midid& > lastd& THEN
 song(songl) = INT((midid& - lastd&) / midistep) - 1 + 128
 songl = songl + 1
 lastd& = midid&
END IF
RETURN

display:
j = songp
FOR i = 0 TO 15
 dispx(i) = 0
 dispn(i) = 0
NEXT i
i = 10 + waitt
WHILE i < 310
 k = song(j)
 temp = INT(k / 16)
 j = j + 1
 SELECT CASE temp
  CASE 0
   i = 320
  CASE 1
   l = song(j)
   j = j + 1
   k = k AND 15
   dispx(k) = i
   dispn(k) = l
  CASE 2
   k = k AND 15
   IF dispn(k) <= 100 AND dispn(k) > 20 AND i > dispx(k) THEN
    rectangle dispx(k), 100 - dispn(k), i - dispx(k), 1, 14 + k * 16, dpage
    dispn(k) = 0
   END IF
  CASE 3
   k = k AND 15
   j = j + 6
   rectangle i - 1, 78, 3, 2, 14 + k * 16, dpage
  CASE 5
   k = k AND 15
   rectangle i, 79, 1, 2, 15, dpage
   textcolor 15 + k * 16, 0
   printstr STR$(k), i - 8, 70, dpage
  CASE 6
   k = k AND 15
   l = song(j)
   j = j + 1
   textcolor 14 + k * 16, 0
   printstr STR$(k) + CHR$(14), i - 8, 70, dpage
   printstr STR$(l), i - 8, 78, dpage
  CASE 7
   printstr CHR$(15), i - 4, 70, dpage
  CASE IS > 7
   i = i + (k AND 127) + 1
 END SELECT
 IF j >= songl THEN i = 320
WEND
RETURN

transfer:
IF recp = 0 THEN RETURN
songp = 0
songl = 0
playsong = 0
byte = 0
recl = recp - 1
setinstused bamuse(), rec(), recl
FOR i = 0 TO 8
 IF bamuse(i) THEN
  song(songl) = i + 48
  songl = songl + 1
  FOR temp = 0 TO 5
   song(songl) = vinst(i, temp)
   songl = songl + 1
  NEXT temp
 END IF
NEXT i
FOR i = 0 TO recl
 song(i + songl) = rec(i)
NEXT i
songl = songl + recl
setinstused bamuse(), song(), songl
RETURN

resetplay:
FOR i = 0 TO 15
tag(i) = 0: rep(i) = 0
NEXT i
RETURN

setdefault:
FOR i = 0 TO 127
keymap(i) = 0
NEXT i
RESTORE defaultkey
FOR i = 36 TO 73
READ keymap(i)
NEXT i
RETURN

quit:
setfmvol oldfm
fadeto buf(), 0, 0, 0
GOSUB shutoff
resetfm
restoremode
SYSTEM

switchon:
regs.ax = &H2509: regs.ds = Keyseg: regs.dx = keyoff
CALL interruptx(&H21, regs, regs)
RETURN

shutoff:
regs.ax = &H2509: regs.ds = seg9: regs.dx = off9
CALL interruptx(&H21, regs, regs)
RETURN

keymapping:
DATA 1,2,3,4,5,6,7,8,9,0,-,=,"","",q,w,e,r,t,y,u,i,o,p,[,],"","",a,s,d,f,g,h,j,k,l,";","'",`,"",\,z,x,c,v,b,n,m,",",".","/"

metronome:
DATA -14,-35,-12,-37,-9,-38,-5,-39,0,-40,5,-39,9,-38,12,-37,14,-35

keydata:
DATA 0,0,5,3,8,2,13,3,16,1,24,0,29,3,32,2,37,3,40,2,45,3,48,1

defaultkey:
'starts at 36
DATA 44,31,45,32,46,47,34,48,35,49,36,50,51,38,52,39,53
'starts at 53
DATA 16,3,17,4,18,5,19,20,7,21,8,22,23,10,24,11,25,12,26,27,14
'ends at 73

REM $STATIC
SUB domidikeyb (ibank$)
 l = readmidi(keyboard())
 i = 0
 WHILE i < l
  j = keyboard(i)
  i = i + 1
  c = INT(j / 16)
  j = j AND 15
  SELECT CASE c
   CASE 8
    n = keyboard(i)
    i = i + 2
    FOR k = lowk TO highk
     IF value(k) = -2 AND note(k) = n THEN stopnote k
    NEXT k
   CASE 9
    n = keyboard(i)
    i = i + 1
    v = keyboard(i)
    i = i + 1
    IF v = 0 THEN
     FOR k = lowk TO highk
      IF value(k) = -2 AND note(k) = n THEN stopnote k
     NEXT k
    ELSE
     k = lowk
     WHILE k <= highk AND (value(k) <> 0 OR bamuse(k) = 1)
      k = k + 1
     WEND
     IF k <= highk THEN
      playnote k, n, -2
     END IF
    END IF
   CASE 10, 11, 14
    i = i + 2
   CASE 12
    n = mkeymap(keyboard(i))
    i = i + 1
    setins n, ibank$
   CASE 13
    i = i + 1
   CASE 15
    i = i + 1
    n = keyboard(i)
    i = i + n
  END SELECT
 WEND
END SUB

SUB drawkey (i, p, x(), which(), pag)
oct = INT(i / 12)
koff = i - oct * 12
temp = which(koff)
IF p = 0 THEN c = 15 ELSE IF p = 2 THEN c = 14 ELSE c = 111
IF temp = 3 THEN
 IF p = 0 THEN c = 8 ELSE IF p = 2 THEN c = 5 ELSE c = 245
 rectangle x(koff) + 56 * (oct - 2) - 18, 80, 4, 27, c, pag
ELSE
 rectangle x(koff) + 56 * (oct - 2) - 19, 108, 7, 14, c, pag
 IF temp = 0 THEN
  rectangle x(koff) + 56 * (oct - 2) - 19, 80, 5, 28, c, pag
 END IF
 IF temp = 1 THEN
  rectangle x(koff) + 56 * (oct - 2) - 16, 80, 4, 28, c, pag
 END IF
 IF temp = 2 THEN
  rectangle x(koff) + 56 * (oct - 2) - 16, 80, 2, 28, c, pag
 END IF
END IF

END SUB

SUB getb2minfo (saven$, channels, chanminst(), chaninst(), voicvel())
 DIM tempinst(19, 6), tempminst(19), tempvel(15)
 temp$ = progdir$ + justname$(saven$) + ".b2m"
 h = openbin(temp$ + CHR$(0))
 IF h <> -1 THEN
  setendian 1
  tempchan = readbyte(h, -1)
  FOR i = 0 TO tempchan - 1
   tempminst(i) = readbyte(h, -1)
   tempvel(i) = readbyte(h, -1)
   FOR j = 0 TO 4
    tempinst(i, j) = readword(h, -1)
   NEXT j
  NEXT i
  closebin h
  FOR i = 0 TO channels - 1
   match = -1
   FOR j = 0 TO tempchan - 1
    insmatch = 1
    FOR k = 0 TO 4
     IF chaninst(i, k) <> tempinst(j, k) THEN insmatch = 0
    NEXT k
    IF insmatch = 1 THEN match = j
   NEXT j
   IF match >= 0 THEN
    chanminst(i) = tempminst(match)
    voicvel(i) = tempvel(match)
   END IF
  NEXT i
 END IF
END SUB

SUB getdir (path$, fmask$, dl(), numd, files$(), dirs$(), fmatch, dmatch)
 IF RIGHT$(path$, 1) = CHR$(0) THEN path$ = LEFT$(path$, LEN(path$) - 1)
 findfiles path$ + fmask$ + CHR$(0), 32, progdir$ + "files.lst" + CHR$(0), buf()
 temp = 0
 OPEN progdir$ + "files.lst" FOR INPUT AS #1
 WHILE EOF(1) = 0 AND temp < 512
  INPUT #1, files$(temp)
  temp = temp + 1
 WEND
 CLOSE #1
 sortstrings files$(), temp
 fmatch = temp
 files$(temp) = ""
 findfiles path$ + "*.*" + CHR$(0), 16, progdir$ + "files.lst" + CHR$(0), buf()
 temp = 0
 OPEN progdir$ + "files.lst" FOR INPUT AS #1
 WHILE EOF(1) = 0 AND temp < 256
  INPUT #1, dirs$(temp)
  IF dirs$(temp) <> "." THEN temp = temp + 1
 WEND
 CLOSE #1
 FOR temp2 = 0 TO numd - 1
 dirs$(temp + temp2) = CHR$(0) + "[" + CHR$(dl(temp2) + 65) + ":]"
 NEXT temp2
 temp = temp + numd
 sortstrings dirs$(), temp
 dmatch = temp
 dirs$(temp) = ""
END SUB

SUB getfour (f, p&, v&)
v& = 0
FOR i = 0 TO 3
GET #f, p& + i, temp
IF temp < 0 THEN temp = temp + 32768
v& = v& * 256
v& = v& + (temp AND 255)
NEXT i
END SUB

FUNCTION justname$ (f$)
 s = 1: e = LEN(f$)
 FOR i = 1 TO e
  t$ = MID$(f$, i, 1)
  IF t$ = "\" OR t$ = "/" OR t$ = ":" THEN s = i
  IF t$ = "." THEN e = i - 1
 NEXT i
 justname$ = MID$(f$, s, e - s + 1)
END FUNCTION

SUB newsong
 songl = 0
 songp = 0
 stopplay
 FOR i = 0 TO 8
  bamuse(i) = 0
 NEXT i
END SUB

SUB playnote (chan, note, id)
 value(chan) = id
 note(chan) = note
 fmkeyon chan, note
 IF recsong THEN
  writedelay
  rec(recp) = 16 + chan
  recp = recp + 1
  rec(recp) = note
  recp = recp + 1
 END IF
END SUB

SUB playtick
 IF waitt > 0 THEN waitt = waitt - 1
 WHILE waitt = 0
  IF songp > songl THEN songp = 0
  i = song(songp)
  temp = INT(i / 16)
  songp = songp + 1
  SELECT CASE temp
   CASE 0
    songp = 0
    waitt = 1
   CASE 1
    j = song(songp)
    songp = songp + 1
    i = i AND 15
    IF i < 10 THEN
     playnote i, j, -1
    END IF
   CASE 2
    i = i AND 15
    IF i < 10 THEN
     stopnote i
    END IF
   CASE 3
    i = i AND 15
    IF i < 10 THEN
     FOR j = 0 TO 5
      inst(j) = song(songp)
      IF bamuse(i) = 1 THEN vinst(i, j) = song(songp)
      songp = songp + 1
     NEXT j
     IF bamuse(i) = 1 THEN setvoice i, inst()
    END IF
   CASE 5
    i = i AND 15
    tagp(i) = songp
   CASE 6
    i = i AND 15
    j = song(songp)
    songp = songp + 1
    IF j = 255 THEN retp = songp: songp = tagp(i)
    IF j = 254 THEN songp = tagp(i)
    IF j < 254 THEN
     IF rep(i) = 1 THEN
      rep(i) = 0
     ELSEIF rep(i) = 0 THEN
      rep(i) = j
      songp = tagp(i)
     ELSE
      rep(i) = rep(i) - 1
      songp = tagp(i)
     END IF
    END IF
   CASE 7
    IF retp <> 0 THEN songp = retp: retp = 0
   CASE IS > 7
    waitt = (i AND 127) + 1
  END SELECT
WEND
END SUB

SUB saveb2minfo (saven$, channels, chanminst(), chaninst(), voicvel())
 temp$ = progdir$ + justname$(saven$) + ".b2m"
 IF isfile(temp$ + CHR$(0)) THEN
  KILL temp$
 END IF
 setendian 1
 f = openbin(temp$ + CHR$(0))
 writebyte f, -1, channels
 FOR i = 0 TO channels - 1
  writebyte f, -1, chanminst(i)
  writebyte f, -1, voicvel(i)
  FOR j = 0 TO 4
   writeword f, -1, chaninst(i, j)
  NEXT j
 NEXT i
 closebin f
END SUB

SUB savebam (saven$, fpat$)
 textcolor 14, 1: printstr saven$, 100, 20, dpage
 IF keyval(0) = 14 THEN
  IF LEN(saven$) > 0 THEN saven$ = LEFT$(saven$, LEN(saven$) - 1)
 ELSEIF keyval(0) = 28 AND saven$ <> "" THEN
  i = 1
  WHILE i < LEN(saven$) AND MID$(saven$, i, 1) <> "."
   i = i + 1
  WEND
  IF MID$(saven$, i, 1) <> "." THEN saven$ = saven$ + ".bam"
  IF isfile(fpat$ + saven$ + CHR$(0)) THEN KILL fpat$ + saven$
  setendian 0
  bnum = openbin(fpat$ + saven$ + CHR$(0))
  IF bnum > 0 THEN
   tmp$ = "CBMF"
   writestring bnum, -1, tmp$
   i = 0
   bytes = 0
   endsong = 0
   WHILE i < songl
    temp = song(i) AND 255
    writebyte bnum, -1, temp
    i = i + 1
    IF bytes = 0 THEN
     IF (temp AND 240) = 16 THEN bytes = 1
     IF (temp AND 240) = 48 THEN
      FOR j = 1 TO 5
       writeword bnum, -1, song(i)
       i = i + 1
      NEXT j
      writebyte bnum, -1, song(i)
      i = i + 1
     END IF
     IF (temp AND 240) = 96 THEN bytes = 1
     IF temp = 96 AND song(i) = 254 THEN endsong = 1
    ELSE
     bytes = bytes - 1
    END IF
   WEND
   IF songl > 2 THEN
    IF endsong = 0 THEN
     temp$ = CHR$(96) + CHR$(254) + CHR$(0)
     writestring bnum, -1, temp$
    END IF
   END IF
   closebin bnum
   bamlook = 0
  END IF
 ELSEIF keyval(0) < 54 THEN
  IF LEN(saven$) < 12 AND skey$(keyval(0)) <> " " THEN saven$ = saven$ + skey$(keyval(0))
 END IF
END SUB

SUB setins (ins, ibank$)
 inst = ins
 FOR temp = lowk TO highk
  IF bamuse(temp) = 0 THEN
   getvoice temp, ins, ibank$ + CHR$(0), inst()
   FOR i = 0 TO 5
    vinst(temp, i) = inst(i)
   NEXT i
  END IF
 NEXT temp
END SUB

SUB setinstused (bamuse(), song(), songl)
 FOR i = 0 TO 8
  bamuse(i) = 0
 NEXT i
 FOR i = 0 TO songl
  temp = song(i)
  IF (temp AND 240) = 16 THEN
   bamuse(temp AND 15) = 1
   i = i + 1
  END IF
  IF (temp AND 240) = 96 THEN i = i + 1
  IF (temp AND 240) = 48 THEN i = i + 6
 NEXT i
END SUB

SUB sortstrings (st$(), num)
DIM ns$(num), nl(num), howmany(46)
FOR lnum = 8 TO 1 STEP -1
FOR i = 0 TO 46
 howmany(i) = 0
NEXT i
FOR i = 0 TO num - 1
 IF (lnum AND 1) = 0 THEN temp = LEN(st$(i)) ELSE temp = LEN(ns$(i))
 IF temp < lnum THEN
  nl(i) = 0
 ELSE
  IF (lnum AND 1) = 0 THEN temp = ASC(MID$(st$(i), lnum, 1)) ELSE temp = ASC(MID$(ns$(i), lnum, 1))
  IF temp > 47 AND temp < 91 THEN
   nl(i) = temp - 46
  ELSEIF temp = 46 THEN
   nl(i) = 1
  ELSEIF temp = 0 THEN
   nl(i) = 46
  ELSE
   nl(i) = 45
  END IF
 END IF
 howmany(nl(i)) = howmany(nl(i)) + 1
NEXT i
FOR i = 1 TO 46
 howmany(i) = howmany(i) + howmany(i - 1)
NEXT i
IF (lnum AND 1) = 0 THEN
 FOR i = num - 1 TO 0 STEP -1
  howmany(nl(i)) = howmany(nl(i)) - 1
  ns$(howmany(nl(i))) = st$(i)
 NEXT i
ELSE
 FOR i = num - 1 TO 0 STEP -1
  howmany(nl(i)) = howmany(nl(i)) - 1
  st$(howmany(nl(i))) = ns$(i)
 NEXT i
END IF
NEXT lnum
END SUB

SUB stopnote (chan)
 IF recsong THEN
  writedelay
  rec(recp) = 32 + chan
  recp = recp + 1
 END IF
 value(chan) = 0
 fmkeyoff chan
END SUB

SUB stopplay
 FOR i = 0 TO 8
  IF bamuse(i) = 1 AND value(i) < 0 THEN fmkeyoff i: value(i) = 0
 NEXT i
END SUB

SUB writedelay
 IF recd > 0 THEN
  rec(recp) = recd - 1 + 128
  recp = recp + 1
  recd = 0
 END IF
END SUB