to MUSIC ; ¤ TD '89
INIT M TX type [AGAIN? (y / n)] if rc = "y [MUSIC] erall fs
end
to INIT
ht cs TX
type [MUSIC] WHT setscrunch 0.468 make "C 0 make "q 0 make "NR 1 make "RNs [6 13 19 26]
label "x
TX type [NUMBER of STAVES ? (max. 4) :]
make "B rq if or (not numberp :B) (4 - :B < 0) [go "x]
Blk GS SYM pu setpos [-280 204]
end
to M
st make "a rc make "b ascii :a
if :a = 1 [HeN]
if :a = 2 [HaN]
if :a = 4 [KwN]
if :a = 8 [AcN]
if :a = ", [KM]
if :a = "# [KRS]
if :a = "b [ML]
if :a = "T [ht TEXT]
if :b = 240 [fd 6.5 make "C :C + 1]
if :b = 254 [SP -25]
if :b = 250 [SP 15]
if :b = 242 [bk 6.5 make "C :C - 1]
if :b = 243 [if :B = 2 [setpos [-280 -126]] if :B = 1 [setpos [-280 -14] make "B 2] if :B = 0 [setpos [-280 94] make "B 1] make "C 0]
if :b = 253 [exit]
if :q = 1 [stop]
if :b = 32 [SP 15] M
end
to Blk
pu ht setpos [-360 240] repeat :B [pd seth 90 repeat 5 [fd 720 bk 720 re pu fd 12 li pd] pu re fd 50]
end
to GS
setpos [-330 204] repeat :B [pd seth 0 repeat 6 [fd 7 rt 30] repeat 3 [fd 9 rt 32] repeat 4 [fd 11 rt 30] fd 40 repeat 7 [fd 3 lt 32] fd 50 rt 10 fd 25 rt 5 fd 10 repeat 6 [fd 2 rt 30] pu seth 0 bk 77] make "B 0
end
to NOOT
ht bk 6.5 make "x 1 make "b 5 label "b if :b = 1 [go "c]
fd :b pd fd 2 * :x pu bk :b + 2 * :x
re fd 1 li make "x :x + 1 make "b :b - 1 go "b
label "c
fd :b pd fd 2 * :x pu bk :b + 2 * :x
re fd 1 li
make "b :b + 1 make "x :x - 1 if :x = 0 [stop] go "c
end
to HeN
HL BG NT SP 50
end
to HaN
HL BG NT ^ SP 30
end
to SO
pu re fd 10 li pd fd 40 if :a = 8 [lt 20 bk 8 lt 30 bk 10 rt 60 bk 8 fd 8 lt 60 fd 10 rt 30 fd 8 rt 20] bk 40
end
to SU
pd bk 40 if :a = 8 [rt 20 fd 8 rt 30 fd 10 lt 60 fd 8 bk 8 rt 60 bk 10 lt 30 bk 8 lt 20]
fd 40
end
to LG
pu TX type [CLEAR SCREEN? (y)] if rc = "y [fs cs pu make "q 1 make "p 2 stop] SYM
end
to TX
setsplit 1 ct
end
to WHT
repeat 500 []
end
to re
rt 90
end
to li
lt 90
end
to BG
pd ht
end
to SP :x
pu re fd :x if :C > 1 [fd 12] li
end
to NT
rt 45 repeat 4 [fd 8.5 rt 90] lt 45
end
to KwN
HL NOOT fd 6.5 li fd 10 re ^ SP 20
end
to ^
if :C > 1 [SU stop] SO
end
to KM
ht repeat 4 - :C [fd 6.5] pd fd 9 bk 13 fd 4 pu repeat 4 - :C [bk 6.5] SP 10
end
to KRS
ht pd bk 6 fd 12 pu re fd 4 re pd fd 12 bk 4 re bk 2 fd 8 bk 2 re fd 4 re bk 2 fd 8 bk 2 li bk 2 SP 6
end
to ML
ht bk 6.5 pd fd 16 bk 16 rt 60 fd 6 repeat 3 [lt 60 fd 3] seth 0 fd 0.5 SP 10
end
to TEXT
if :NR = 5 [make "NR 1 SYM stop]
make "SC se 9 item :NR :RNs
setcursor :SC make "TXT rq
setcursor :SC type :TXT
make "NR :NR + 1
TEXT
end
to exit
TX type [EXIT: s = save, l = load, c = clear screen , q = quit :]
make "a rc
if :a = "s [SV]
if :a = "q [make "q 1 stop]
if :a = "c [LG]
if :a = "l [LD] ct SYM
end
to AcN
HL NOOT fd 6.5 li fd 10 re ^ SP 15
end
to SYM
TX type [SYMBOLS: 1 = 1 2 = © 4 = ¨ 8 = ¶ # = # b = flat , = , T = TEXT (EXIT = other options)]
end
to HL
if :C = -4 [hl]
if :C = -5 [fd 6.5 hl bk 6.5]
if :C = 8 [hl]
if :C = 9 [bk 6.5 hl fd 6.5]
if :C = 10 [bk 13 hl fd 6.5 hl]
end
to hl
li pd fd 5 bk 20 fd 15 pu re
end
to LD
NAAM if :nm = " [ct stop] if not emptyp dirpic :nm [loadpic :nm stop] DIR
end
to NAAM
ct type [NAME?] make "nm rq
end
to DIR
type [DIR:.] WHT ct type dirpic "A: WHT ct
end
to SV
NAAM if :nm = " [ct stop] if emptyp dirpic :nm [ct savepic :nm stop] type [EXISTS!!] DIR
end
 rt 60 fd 6 repeat 3 [lt 60 fd 3] seth 0 fd 0.5 SP 10
end
to T