music player_ 27/1/68

mot=ivk 77
dat=ivk 21

org=20000	/origin of music on drum
nbuf=34.	/number of drum buffers per field
lbuf=120.	/size of each
size=lbufxnbuf	/space taken on each field (4080.)
mar=16.	/margin after each buffer
la2=iot 5077

dimension sec(1)	/section number
dimension msn(1)	/beginning measure number
dimension bno(1)	/initaial block number of file
dimension rep(1)	/tape word pointer
dimension ptb(1000)	/tape block table

0/	jmp set	/initial entry
3/	jmp .
	law 600
	dap pls	/tell control not to play
gtc,	lio (sct	/read in control section
	dia
	lio (i enm-sct
gts,	law sct
	dcc
	hlt
	jmp sct

set,	lio (i
	dia
	cli>>05<<cla
	dcc	/write out entire program
	hlt
	jmp 4

tm2,	200	/tempo word
twn,	3	3	3	3
tpn,	-0
vol1,	0
vol2,	0
op,	0
dp,	0
mss,	skp	/skip if any music is on drum
pls,	skp	/switch to play after compilation

txx,	dap txy
	aam
	lio txy
	idx txy
	lac (607600
	rcl 6s
	sad (lai
txy,	jmp .
	sad . 2
	jmp txx 1
	swp
	tyo
	lia
	jmp txy-3
                
3                                
/read tape, block number in AC

/F4 . forward
/F5 . in end zone
/F6 . moving

rdt,	0
	dap trx
	law 777
	and rdt	/desired block
	sub (400	/translate it
	TAAI<
	cma
	ral 1s
	add (776
	spi
	add (3
	dac trb	/translated block

/main loop

mtl,	mot 100	/skip if ready
	jmp mt0	/no
	mot 300	/skip if end of tape
	jmp mt1
	clf 6	/tape not moving any more
	lio enz
	szf 5
	jmp sre	/already know about it
	stf 5
	rpf
	rir 3s
	dio enz	/store end info
	jmp sre

mt1,	clf 5	/out of end zone
	lac trb
	sub bkn
	szf i 6
	jmp ms1	/not moving
	szf i 4
	cma	/number of blocks to go
	add (5
	szm
	jmp try
mst,	clf 6	/5 blocks past, turn around
	law 1
	szf i 4
	cma
	adm bkn	/coast distance
	jmp mtl
                
l                                
ms1,	TAI>	/start tape
	cma
	sub (5
	spq
	cmi	/too close, go away from it
srt,	law 4	/IO + to go forward, - for reverse
	spi i
	cma
	adm bkn	/accelerate distance
sre,	spi i
	mot 600	/fwd
	spi
	mot 700	/rev
	mot 400	/go
	stf 6
	clf 4
	spi i
	stf 4	/direction flag

try,	lac trb	/try reading it
	dat 4500	/read
	dat 300	/get status
	spi
	jmp m16	/wrong block
	ril 2s
	spi
	jmp mtl	/block timing error
	ril 1s
	spi
	jmp mtl	/end of tape
	rir 2s
	dac bkn	/actual block number
	spi
trx,	jmp .	/transfer finished
	cla>>05<<clf 6
	ril 1s
	SAA
	TI.<
	jmp .-3
	skp i
mt0,	cla>>05<<clf 6
	mot 500	/stop
	hlt	/error
	jmp mtl
m16,	dat 200	/read block number
	law 1777
	A^IA
	dac bkn
	jmp mtl

enz,	0	/end zone flag, - . 777, + . 0
trb,	0	/translated block
bkn,	0	/actual block number

constants
variables
sct,
                
a                                
/control section

dimension dir(1000)	/directory from tape
dimension cb(1)	/end-of-symbol flag
dimension ca(1)	/symbol terminator
dimension c(1)	/character packing count
dimension num(1)	/value of number
dimension poi(1)	/end of text buffer
dimension tex(20)	/input symbol buffer

sct,	xct pls
	jmp go	/play music
in,	iam
	eem
	lio (77
	tyo

/read command

lup,	jdp res
	szf i 5
	jmp lup
	law cmt
	jdp lkp
	jmp err
	jmp i flv

err,	jsp txx
	text .?_.
	jmp in

app,	law 600	/append
	dap pls
	xct mss
	jmp loa	/drum is empty
	jmp plb
pla,	ZAP	/play
loa,	law 600	/load
	dap pls
	lac (org	/clear the drum
	dac dp
	law bf2
	dac op
plb,	clc
	sad tpn
	jmp ntt	/no tape mounted
	mot 100
	jmp tnr	/not ready
	dac sec
	dac msn
	law 1
	dac flv	/pointer to entire directory
lo1,	law 77
	sad ca
	jmp lo9	/end of line
	jdp res
	szf i 5
	jmp lo1	/no symbol
	lac flv
	spa
	jmp lo6	/already at lowest level
	add (dir
	jdp lkp
	jmp nof
	aam
	lac flv
	jmp lo1-1

                
7                                lo6,	lio num	/section number or measure number
	lac sec
	TAM|
	dio sec	/section number
	TAM
	dio msn	/starting measure number
	jmp lo1

lo9,	lac flv
	sma
	hlt	/several files at once
	and (777
	dac bno	/initial block number
	lac (77777
	dac rep
	lio (i sct	/write out control section
	dia
	lio (enm-sct
	law sct
	dcc
	hlt
	lio (enm	/read in compiler
	dia
	lio (i enc-sct
	jmp gts

ntt,	jsp txx
	text .no tape_.
	jmp in
tnr,	jsp txx
	text .tape not ready_.
	jmp in

/read and copy block, block number in IO, address in AC

cpb,	0
	dap cpx
	lai
	jda rdt
	lac (77400
	dac rdt
	nam
	lio i rdt
	dio i cpb
	idx cpb
	idx rdt
	sas (100000
	jmp .-5
	iam
cpx,	jmp .
                
                                
lkp,	0	/look up name
	dzm .flv
	dac .dlp
	aam
	add dlp
	dac .dz
	idx dlp
q,	dap dq
	sub dz
	sma
	jmp z	/directory ran out
	stf 6
	stf 5
	ZX
a,	law i 3
	dac .c
	lac i tex
dq,	lio i .
	SXX|
b,	lac .t
	ral 6s
	dac t
	ril 6s
	and (77
	sad (77
	clf 5	/typed string ran out
	law 77
	A^IA
	sad (77
	jmp d	/directory entry ran out
	xor t
	and (77
	sza>>05<<szf 5
	clf 6	/entries don't agree
	isp c
	jmp b
	jmp a
d,	szf i 6
	jmp lke	/wrong entry
	lac flv	/right entry
	sza
	jmp amb	/too many
	lac dlp
	dac .flo
	X+AA
	dac flv
lke,	SXA
	adm dlp
	jmp q
z,	sza
	jmp ano
	lxr .flv
	TXP
	idx lkp
	jmp i lkp
                
>>60<<                                
ano,	jsp txx
	text .anomalous directory_.
	jmp in

amb,	jsp txx
	text .amb_.
	jmp in

nof,	jsp txx
	text .not found_.
	jmp in

wai,	cli>>05<<cla>>05<<hlt>>05<<lai>>05<<clf 7
go,	xct mss	/play
	jmp err	/no music
	ZAX	/set up tuning tables
	law twn
	dap tn2+3
tn2,	law pt
	dap ti
	cla
	lac .
	sub (3
	dac ca
ti,	lac .
	mul ca
	scl 9s
	swp
	xct ti
	A+IA
	dac i 4000
	dac i 4001
	law 2
	A+XXA
	sad (1000
	jmp tn3
	idx ti
	sas (lac pt+100
	jmp ti
	idx tn2+3
	jmp tn2
tn3,	lio (i sct	/write out control section
	dia
	lio (enm-sct
	law sct
	dcc
	hlt
	szs 20
	jmp .-1
	lio (enm+enc-sct	/read in player
	dia
	lio (i enp-sct
	jmp gts

tem,	law 77	/load tempo
	sad ca
	jmp err
	jdp res
	szf i 5
	jmp tem
	law i 40
	add num
	spa
	jmp ts
	law 777
	and num
	sas num
	jmp tf
	dac tm2
	jmp in
ts,	jsp txx
	text .too slow_.
	jmp in
tf,	jsp txx
	text .too fast_.
	jmp in

tun,	law twn
	dap tu1
tu0,	law 77
	sad ca
	jmp lup
	jdp res
	szf i 5
	jmp tu0
	law 7
	and num
tu1,	dac .
	idx tu1
	sas (dac twn+4
	jmp tu0
	jmp in

unt,	jdp rwt	/unload tape
	jmp in

rwt,	0
	clc
	sad tpn
	jmp i rwt
	dac tpn
	mot 700	/reverse
	mot 400	/go
	dat 400	/search
	mot 300	/wait for end zone
	jmp .-2
	jmp i rwt

tap,	law 77	/load tape
	sad ca
	jmp err	/no argument
	jdp res
	szf i 5
	jmp tap
	jdp rwt	/rewind old tape
	law 17
	and num
	dac tpn
	rcr 6s
	dat	/data select
	mot	/motion select
	law 7400
	dat 100	/channel address
	clf 7
	law dir
	lio (4
	jda cpb	/read directory
	law dir+400
	lio (5
	jda cpb
	law ptb
	lio (6
	jda cpb	/and block table
	law ptb+400
	lio (7
	jda cpb
	mot 500	/stop
	jmp in

dre,	hlt
                
a                                
/read and pack symbol

res,	0
	clf 7
	ZX
	dzm num
lu0,	law i 3
	dac c
lu1,	clf 1
	szf i 1
	jmp .-1
	tyi
	lai
	sad (40
	jmp in	/cancel
	sad (36
	cla
	dac ca	/space, comma, c.r., or symbol
	sas (33
	sza i
	law 77
	dac cb	/c.r. or symbol
	sad (77
	jmp lu4
	sad (charac r0
	cla
	lia
	lac num
	ral 2s
	add num
	ral 1s
	A+IA
	dac num
	stf 5
lu4,	lio i tex
	lac cb
	rar 6s
	rcl 6s
	dio i tex
	isp c
	jmp lu3
	SXXA
	dac poi
	sad (20
	hlt	/text buffer overflow
	law 77
	sas cb
	jmp lu0
	jmp i res
lu3,	law 77
	sas cb
	jmp lu1
	jmp lu4
                
(                                
pt,	/prototype pitch table

/twelfth root of 2 = 1.059463094359295264581

0	2147	2252	2361
2474	2614	2740	3072
3231	3375	3547	3730
4120	4316	4524	4742
5171	5430	5701	6164
6461	6772	7317	7660
10237	10634	11250	11704
12361	13060	13602	14350
15143	15764	16636	17541
20476	21470	22521	23611
24742	26140	27404	30717
32305	33751	35474	37301
41175	43161	45241	47421
51705	54300	57007	61636
64613	67721	73170	76603
102372	106342	112502	117042

pt+100,

cmt,	cme-cmt
	text /load/ 7777	jmp loa
	text /append/
	-0	jmp app
	text /play/ 7777	jmp pla
	text /go/ 77	jmp go
	text /wait/ 7777	jmp wai
	text /tempo/ 77	jmp tem
	text /tune/ 7777	jmp tun
	text /untape/
	-0	jmp unt
	text /tape/ 7777	jmp tap
	text /directory/
	-0	jmp dre
cme,

consta
variab
enm,	/end of control section
                
>>17<<                                
/compiler section

offset enm-sct

dimension bf2(lbuf)	/drum buffer
dimension off(1)	/measure offset
dimension nl(1)	/packing pointer
dimension ij(1)	/part number
dimension np(1)	/number of parts
dimension ct(1)	/word count
dimension tm3(1)	/tempo information

dimension b1(4)	/bar pointers
dimension n1(4)	/note pointers
dimension t1(4)	/time left in this note
dimension p1(4)	/pitch
dimension f1(4)	/articulation flag (- when part runs out)
dimension a1(4)	/articulation time

sct/	eem	/?
	iam	/?
	dzm ij
	law not
	dac nl
	clf 7	/initialize tape
gnp,	jdp gwd	/read one part
	spa
	jda er	/no more parts
	cma
	dac ct
	law 4
	sad ij
	jmp tm	/too many parts
	clf 2	/goes on when bars begin
	lac nl
	dac off	/note offset
re1,	jdp gwd
	szf 2
	add off	/relocate
	sza i
	jmp re6	/note/bar marker
	aam
	dac nl
	idx nl
	sad (77400
	jmp sf	/storage full
	sad (20000
	lac (70000
	dac nl
                
/                                
	jmp .+2
re6,	stf 2
	isp ct
	jmp re1
	lxr ij	/end of part
	law i 1
	add nl
	dac i b1
	idx ij
	jmp gnp
er,	0
	mot 500	/stop tape
	lac sec
	TAM
	sub (1
	dac sec
	cma>>05<<lia
	TI=
	jmp end	/skip this section
	ior er
	dac er
	lac ij
	dac np
	sza
	jmp re8
	jsp txx
	text /No parts
_/
	hlt
sf,	jsp txx
	text /Storage full. Subdivide all parts.
_/
	hlt
tm,	jsp txx
	text /Too many parts.
_/
	lac (jmp
	jda er
                
,                                
re8,	law 1	/begin compilation
	lio (250000
	div tm2
	hlt
	dac tm3	/set initial tempo=170
	law 252
	dac vol1
	dac vol2
	law i 2	/read back last buffer
	adm op
	law 7777
	and dp
	lia
	dia
	xor dp
	ior (lbuf
	lia
	law bf2
	dcc
	hlt
	jmp q0
                
9                                
q0,	dzm .bc	/bar count
	dzm .mes	/last bar in error
	law (600000
	lxr (-4
	dzm i t1+4	/clear out all unused parts
	dzm i p1+4
	dac i n1+4	/initialize first measure
	SXXP
	jmp .-4
q8,	idx .bc	/initialize measure
	clf 2
	dzm ij
	clc
	dac .pro
lu2,	lxr ij
q89,	lac i n1
	dac .foo
	aam
	lac foo
	and (law
	sas (jmp
	hlt	/last measure not ended
	lac i b1
	dac .foo
	aam
	lac foo
	sad (jmp
	jmp q88	/part has run out
	stf 2	/F2 means some part still has bars
	dac i n1
	law i 1
	adm i b1
q86,	dzm i f1
q86+1,	dzm i t1
	idx ij
	sas np
	jmp lu2
	szf 2 i
	jmp end	/all parts are out
	lac .pro
	sma
	jmp q56	/some part has run out
                
c                                
/get time for each part. If part is at end of bar or end of music,
/get zero
q9,	dzm .ij
	law 2s
	dac .sfl	/shift counter for volume
	clc
	dac ps
	clf 5
q10,	lxr ij	/check this part
q15,	lac i t1
	mul tm3
	scl 8s
	sub (12.
	sma	/see if 5 ms. exist in this note
	jmp q13	/sufficient time exists
	lac i f1	/refill
	szm
	jmp q14	/flag on, get articulation
gnn,	lac i n1
	dac .po1
	aam
	lac po1
	dac po1
	ral 3s
	and (7
	add (q1x
	dap q12
	law 777
	and po1
	dac .temp	/duration
q12,	xct .
e,	dac i a1
	cma
	adm i t1
	idx i f1
l,	lac po1
	ral 9s
	and (77	/pitch
	dac i p1
	idx i n1
	sad (20000
	lac (70000
	dac i n1
	lac temp
	ral 3s
	adm i t1
	jmp q15
                
6                                
q1x,	jmp l	/l
	jmp s	/s
	nop	/e
	ral 1s	/h
	ral 2s	/q
	jmp svl	/set volume
	jmp q13	/end of bar, can't get any time
	jmp q1y	/set tempo

q1y,	law 1777	/set new tempo
	and po1
	cli
	scr 7s
	div tm2
	hlt
	dac tm3
q1z,	idx i n1
	sad (and
	lac (law
	dac i n1
	jmp gnn

s,	ral 2s
	add temp
	jmp e

svl,	lac sfl
	ior (ral
	dac sv1
	add (rar-ral
	dac sv2
	lac vol1
	rar 8s
sv1,	xx
	lio temp
	rcr 2s
sv2,	xx
	rar 8s
	dac vol1
	jmp q1z

q14,	dzm i p1
	lac i a1
	adm i t1
	dzm i f1
	jmp q15
q13,	lac i t1
	sza i
	jmp .+3	/no time
	stf 5	/F5 means some part has time
	jmp q77+1
	lac i f1
	spa
	jmp q77	/end of part already noted
	lac ij
	dac .ps	/some part is short
q77,	dzm i p1	/if no time, make it a rest
	lac sfl
	ral 2s
	add (2s
	dac sfl	/sfl=2s,4s,6s,8s
	idx ij
	sas np
	jmp q10	/check next part
                
/                                
	szf 5 i
	jmp q8	/no time in any part
	lac .ps
	sma
	jmp mis	/some part is short
q99,	lac t1	/calculate least time
	sza i
	law 7777
	lio t1+1
	sni
	jmp .+5
	sub t1+1
	sma
	cla
	add t1+1
	lio t1+2
	sni
	jmp .+5
	sub t1+2
	sma
	cla
	add t1+2
	lio t1+3
	sni
	jmp .+5
	sub t1+3
	sma
	cla
	add t1+3
	dac temp
	cma>>05<<lia
	add t1
	sma
	dac t1
	lai
	add t1+1
	sma
	dac t1+1
	lai
	add t1+2
	sma
	dac t1+2
	lai
	add t1+3
	sma
	dac t1+3
	lac temp
	mul tm3
	scl 6s
	dac temp
	lac vol1
	sad vol2
	jmp d2
	dac vol2
	jda put
	clc
	jda put
                
>>76<<                                
d2,	lac p1
	ral 6s
	ior p1+1
	ral 6s
	ior p1+2
	jda put
	law 7770
	sub temp
	sma
	cla
	add temp
	lia
	cma
	adm temp
	cmi>>05<<lai
	and (7777
	ral 6s
	ior p1+3
	rar 6s
	jda put
	lac temp
	sza
	jmp d2	/if too long, break it up
	jmp q9

end,	lac er
	ral 1s
	sma
	jmp sct	/compile more
	cla	/end of music
	jda put
	jsp put+1
	lio dp
	dia
	lio (lbuf
	law bf2
	dcc	/write out last buffer
	hlt
	law 7777
	and dp
	sza
	jmp en2
	law i i-size
	add dp
	dia
	lio (i-size
	law bf2
	dcc	/write out patch at top of last field
	hlt
en2,	law 600
	dap mss	/music now exists
	jmp gtc	/bring back control section
                
e                                
put,	0
	dap pux
	law bf2+lbuf
	sad op
	jmp wrb
	lac put
	aam
	dac op
	idx op
pux,	jmp .

wrb,	lio dp
	dia
	lio (lbuf
	law bf2
	dcc
	hlt
	law bf2
	dac op
	law lbuf
	adm dp
	and (7777
	sad (lbufxnbuf
	jmp wr2
	sas (lbuf
	jmp put+5
	law i lbuf+i-size
	add dp
	lia
	dia
	lio (i-size
	law bf2
	dcc
	hlt
	jmp put+5
wr2,	law i-size
	adm dp
	jmp put+5

q88,	lac i f1	/part is out of music
	spa
	jmp q86+1	/already know about it
	lac ij
	dac .pro	/record that fact
	clc
	dip i f1
	jmp q86+1

q56,	jsp txx
	text /Part _/
	law 1
	add pro
	jdp dpt
	jsp txx
	text / is out of music at measure _/
	lac bc
	jdp dpt
	jsp txx
	774000
	jmp q9
                
n                                
mis,	lac bc
	sad mes
	jmp q99	/error already printed
	jsp txx
	text /Measure _/
	lac bc
	jdp dpt
	jsp txx
	text / of part _/
	law 1
	add ps
	jdp dpt
	jsp txx
	text / is too short.
_/
	lac bc
	dac mes
	jmp q99

dpt,	0
	dac .dp1
	dzm .dp2
dpp,	dac .dp3
	mul (1
	div .+1
	10.
	sas dp2
	jmp dpp
	sni
	lio (20
	tyo
	lac dp3
	dac dp2
	lac dp1
	sas dp2
	jmp dpp
	jmp i dpt

gwd,	0	/read word from tape
	idx rep
	sad (100000
	jmp .+4
	aam
	lac rep
	jmp i gwd
	lac (77400
	dac rep
	lac bno
	sza i
	hlt	/ran off end of file
	jda rdt
	lxr bno
	lac i ptb
	dac bno
	jmp gwd+4

constants
enc,
variables
not,
                
6                                
/player

dimension buf(lbuf+mar)

offset enm+enc-2xsct

sct/	lem
	nam
	law brk
	dap 3
	jmp pl1

brk,	cks
	ril 5s
	spi i
	jmp dsb
	lio mpa
	dia
	lio mpf
	law buf
	dcc
	hlt
	law i lbuf
	adm ptr
	law 7777
	and 1
	sub (saf
	spa
	jmp .+3	/not safe to bump XR
	law 15.
	X+AX
	lac i p11
	ral 4s
	adm t11
	lac i p22
	ral 4s
	adm t22
	lac i p33
	ral 4s
	adm t33
	lac 2
	ral 4s
	adm t44
dsb,	lac 0
	lio 2
	jmp i 1

pl1,	cli>>05<<cmi
	la2
	dzm t11
	dzm t22
	dzm t33
	dzm t44
	law 252
	lea
	law buf
	dap ptr
	lio (org lbuf+mar
	dio .mpf
	dzm .mpa
	cli
	dia
	lio (org lbuf+mar
	law buf
	dcc	/read first buffer
	xx
	cbs
	esm
	jmp ptr
                
m                                
.+.^1/
vol,	sni
	jmp fin	/end of music
	TXI
	lei
	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 114
	lac i p33
	ral 1s
	adm t33
	iot 214
	xct p44
	jmp nxm

ptr,	lxr .
	idx ptr
	lai	/make up for some lost time
	ral 1s
	adm t44
	iot 114
	lio i ptr
	TI|=
	jmp vol	/change volume or end of music
	law i 54
	rcl 6s
	ral 1s
	dap p22
	lac i p11	/fix up other parts
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
	rir 2s
	X.IX
saf,	law 20
	rcl 6s
	ral 1s
	dap p11
	law 21
	rcl 6s
	ral 1s
	dap p44
	law 22
	rcl 6s
	ral 1s
	dap p33
                
>>32<<                                
p44,	lio .
	lai	/make up for more lost time
	ral 1s
	adm t44
	iot 114
	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
p00,	lai
	adm t44
	iot 114
p11,	lac .	/this location must be odd
	adm t11
	iot 14
p22,	lac .
	adm t22
	iot 314
p33,	lac .
	adm t33
	iot 214
	SXX.>
	jmp p00
nxm,	idx ptr
	sas (lxr buf+lbuf
	jmp ptr
	lai
	ral 1s
	adm t44
	iot 114
	law lbuf
	adm mpa
	sas (size
	jmp nx2
	dzm mpa
	lac (i
	adm mpf
	jmp nx3
nx2,	repeat 6,nop
                
6                                
nx3,	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
	law i 15.
	add mpa
	lia
	dba
	xct p44
	jmp ptr

fin,	lsm
	szs 60
	jmp pl1
	law 3
	dap .
	jmp gtc-2

.>>05<<./
t11,	0
t22,	0
t33,	0
t44,	0

repeat ifn p22^1,[printx /try again
/]

constants
enp,
variables
start 0
                
>>32<<