TX-0 SOLITAIRE=Tape 2 - Mechanics of Play

octal	14000|	tra ams
20|	tra mst
	tra mkm
	tra res
	tra rrn
30|

|DECIMAL INTEGER PRINT - S.G.

	zz=.

define	indcpt A
	llr (tra .+3
	slr zz+45
	tra A
	term

sdn,	llr (cyr
	slr zz+37
	tra sds
mdn,	llr (cyr
	slr zz+37
mds,	llr (cyr
	slr zz+51
sds,	llr (char r--char r+
zz+10,	trn .+2
	com+lro-opr
	slr tt+1
	llr (trn zz+46
	slr zz+36
	llr (add zz+56
	slr zz+26
	alo
zz+20,	cla
	tra .+3
	ial
	add (1
	ial
	sto tt
zz+26,	hlt
	trn .-5
zz+30,	lac
	trn zz+35
	add (add zz+64
	sto .+1
zz+34,	hlt
	add (flex +0t
zz+36,	hlt
	pnt
zz+40,	llr tt
	ado zz+26
	add (-add-zz-63
	tze zz+24
	trn zz+20
zz+45,	hlt
	llr (cyr
	slr zz+36
zz+50,	add tt+1
	pnt
	llr (pnt
	slr zz+37
	slr zz+51
	tra zz+37

zz+56,	decimal
	100000
	10000
	1000
	100
	10
	1
	octal
zz+64,	zz=flex +0t+add
	flex  0 -zz-.
	flex +1t-zz-.
	flex +2t-zz-.
	flex +3t-zz-.
	flex +4t-zz-.
	flex +5t-zz-.
	flex +6t-zz-.
	flex +7t-zz-.
	flex +8t-zz-.
	flex +9t-zz-.


|END DECPNT SUBROUTINE

|RATIO PRINT SUB

octal		zz=.

define	ratiopnt A,B	|prints ratio of c(A)/c(B) - unsigned
	cla		|c(A) less than or equal to c(B)
	add A
	llr (tra .+4
	slr zz+73
	llr B
	tra zz
	terminate

zz,	tze zz+30		|perform division
	trn .+2
	com
	sto tt
	lac
	trn .+2
	com
	sto tt+2
zz+10,	com+lro-opr
	sto tt+1
	add tt
	trn zz+74
	tra .+7
	ial+cry-lpd
	trn .+2
	tra .+8
zz+20,	ial+cry-lpd
	add tt+1
	trn .-5
	add tt+2
	ial+cry-lpd
	add (-1
	trn .-6
	add (1
zz+30,	alo		|print fraction
	add (char r.
	pno
	lac
	llr (777
	alp
	sto tt
	slr tt+1
zz+40,	llr (-4
	slr tt+2
	llr tt+1
	lal
	cyl
	lad
	cyl
	llr (777

zz+50,	alp
	slr tt+1
	llr tt
	ial+cry-lpd
	cyl
	add tt
	cyl
	lad
zz+60,	llr (377000
	alp
	slr tt
	cyl
	add (add fnt
	sto .+2
	cla
	xx
zz+70,	pno
	ado tt+2
	trn zz+42
zz+73,	xx		|exit
	cla
	add fnt+1
	pno
	tra zz+30

|end of ratio print sub

|Print subroutines

rad,	slr clx		|color counter sub - red entry
	llrc 1
	tra .+3
blk,	slr clx		|black entry
	llcc (-1
	add rbn
	tze clx-1
	slr rbn
	clac char r	|color shift
	pno
	lro
clx,	xx
rbn,	-1

prn,	slr prx		|register print sub
	llrc 111111
	alp
	cyr
	sto tm1
	lac u lro
	tze .+2
	pno
	add tm1
prx,	xx
	tra prn+1

tpt,	lac		|text printing sub
	acst 2,.+2
	move xx,tp1
	acst add+1-llr,tp2
	acst tra+1-add,tpx
	call blk
	cla
tp1,	xx
	print
	ado tp1
tp2,	xx
	trn tp1-1
	cal
tpx,	xx
|CHARACTER PLOT SUBROUTINE  OS-3 = 6-12-61 - sorta
	zz=.

define
	plot
	llr (tra .+2	tra zz	term

define
	basept A
	llr A	slr zz+45	term

|begin routine

zz,	slr zz+33
zz+1,	sto .+1
	hlt
zz+3,	cla
	add zz+46
	ial+cry-lpd
	trn zz+34
	ial
	add zz+41
	trn zz+5
	add zz+42
	add zz+45
	sto zz+45
	cla
	add zz+44
	cyl
	sto zz+44
	trn zz+3
	cyl
	sto zz+44
	trn zz+27
	ado zz+2
	tra zz+2
zz+27,	cla
	add zz+45
	add zz+43
	sto zz+45
zz+33,	hlt
zz+34,	ial+com-opr
	add zz+45
	dis+com-opr
	add zz+45
	tra zz+10
zz+41,	1	|col cnt index
	1000-1	|baspt index
	2000	|space after character
	622622	|counter
	0	|basepoint
	-10	|column counter set
|SIZE CONTROL ROUTINE

define
	size N
	llr (tra .+4
	slr zz+71
	llr (N
	tra zz+47
	term

zz+47,	lal	cyl	cyl
	com
	sto zz+46
	repeat 6,cyl
	lad
	com
	sto zz+42
	lad
	cyl
	sto zz+43
	slr zz+41
zz+71,	hlt

|END SIZE CONTROL ROUTINE


|READ IN RANDOM NUMBERS: TX-0 SOLITAIRE

rrn,	move sas-1,sas
	load plo,add brn
	load plo+2,sto brn
rdt,	r1c
	alr
	tst0 -char l
,sas			|is char a cr7>>61<<.
	tell 444444,rdt	|is char a code delete7>>61<<.
	tell 440004,rdt	|is char a stop code7>>61<<.
	load sas,opr
	tra rdt
sas,	xx
	load tt,-2
ree,	r1c
	alr
	tst0 -440004,nom	|is char a stop code7>>61<<.
	lac
plo,	xx
	cyr
	xx
	ado tt
	trn ree
adv,	ado plo
decimal	stptst plo+2,brn+63,sas
nom,	llcc plo+2
	acst 1,lat

|end of read in random numbers

|MODE SET: TX-0 SOLITAIRE
octal
res,	check loi,cct	|is a logic tape loaded7>>61<<.
	txtpnt be2,ee2	|print logic title
	add lgn
	print
	carret
cct,	stz wns		|clear counters
	stz gms
	stz yy+2
mst,	tac		|examine tac for mode set
	trn chk
aut,	llrc tra dep	|set mode for automatic
rnt,	slr des
	load t3x,tra des
	load dux,tra log
	load per,tra rst
	llac lrs
	trn .+2
jkl,	load dlj,opr
	check loi,dns
msx,	tra shf		|exit
chk,	cyl		|determine mode
	trn dsp
	cyl
	trn dbg
	cyl
	trn man
	tra aut
dsp,	load sts,tra std	|set mode for display
	llrc opr
	tra rnt
dbg,	cyl		|set mode for debug
	sto tt
	check loi,dns
	load dul,tra log
	load per,opr
	check dlj,rem+1
rem,	lac
	sto dlj
	slr des
	slr dux
	clad tt
	cyl
	trn .+2
	load sts,tra std
	load t3x,tra dep
	tra msx
man,	sto tt		|set mode for manual
	load per,tra rst
	load dul,tra mkm
	subr rem,opr-tra
dns,	txtpnt blm,elm	|illegal mode set attempted
	xx
	tra mst

|end of mode set

|SHUFFLE: TX-0 SOLITAIRE

decimal
shf,	load cod,slr dek
	clear pak,pak+51,1
rne,	random
tst,	alm
	test 53,rne
	lac
	tze rne
	adndo (add pak-1
	tze mxp
	lac
	acst stz pak-1,cod-1
	xx
cod,	xx
	stptst cod,slr dek+51,rne
shx,	clad dux
	test add,dea
	deckpt
	tra dea

mxp,	ado yy+3
	tze rne
	add yy
	ial u com
	cyr u cry
	sto yy
octal	llrc 77
decimal	ana
	tra tst

rdm,	slr rdx
	stz tt
	stz tt+1
	call bit
	add tt
	all
	sto tt
	stptst tt+1,5,rdm+3
	lal u lro
rdx,	xx

bit,	slr bix
	llr brn
	lal
	sto brn
	llrc trn
	anl
	ado bit+1
	ado bit+3
	add lat
	trn rdi+1
	slr tt+4
	load bit+1,llr brn	slr lop+1
	load bit+3,sto brn	slr lop+3
	count yy+1,thy
rdi,	llac tt+4
bix,	xx

thy,	ado lop+1
	llcc lat
	acst slr+1,lop-1
	move brn,xx
lop,	lac
	xx
	cyr u cry
	xx
	ado lop+1
	ado lop+3
	add lat
	trn lop
	tra rdi

|end of shuffle

|DEAL: TX-0 SOLITAIRE

dea,	clear pak,edc,-1
	load dcd,llr (slr st1
	load dcd+2,llr dek
dcd,	move xx,.+3
	move
	ado dcd
	stptst dcd+2,llr dek+27,dcd
	move dcd,ini
	load ini+1,slr crd
ini,	move
	ado ini
	stptst ini+1,slr dn7,ini

dek=dek+28
	stz trc
	stz mvc
	stz yy+4
	stz pk1
	load pk2,13
	load pk3,26
	load pk4,39
	cal
dlj,	opr

|end of deal

|DETERMINE ALL POSSIBLE PLAYS: TX-0 SOLITAIRE

des,	tra acd
	status
dep,	clear mv1,noc,-1
	clad edc
	tze wck+1
ty1,	move crd,.+3	|type 1 - dek to stk
	clc
	xx
	trn tr3
	load pum+1,slr mv1
	load kns,slr mv4
	movdet crd
ty2,	load t2d+1,slr mv2		|type 2 - dek or stk to pak
	load t2b,llr crd
t2a,	load t2c,llr pk1
t2b,	move xx,.+3
t2g,	check xx,t2f
	addc -1
t2c,	xx
	lcd
	tze t2d
	stptst t2c,llr pk4,t2g
t2f,	clad t2b
	tst0 -llr-crd,t2h
	tra t2e
t2d,	move t2c,xx
	stz mov
t2h,	ado .-2
	sto .+2
	move t2b,xx
	ado t2d+1
t2e,	stptst t2b,llr up7,t2a
ty3,	load uct+1,add st1		|type 3 - stk to stk
	load pum+1,slr mv3
	load kns,slr mv4+1
	load sps,slr mv4+5
uct,	clad xx
	movdet uct+1
	idxtst uct+1,13,add st7,uct
ty4,	llcc mv4+5		|type 4 - king to blank space
	trn clo
	load mv4,-1
	z=0	repeat 4,z=z+1	slr mv4+z
clo,	llcc mv4
	trn .+4
	check mv4+1,.+4
	stz mov

fet,	load fbg+1,add mv3+1	|interchange routine
	load fed+1,add mv3+2
fbg,	check xx,dux-1
	search
	alr
fed,	check xx,fee
	lcd
	tze int
fbe,	ado fed+1
	stptst fed+1,add mv3+18,fed
fee,	ado fbg+1
	ado fbg+1
	alr u com
	test add mv3+19,dux-1
fes,	slr fed+1
	ado fed+1
	tra fbg
int,	move fbg+1,di2+1
	lac
	acst -slr,di2+3
	acst -slr-1,di1+3
	acst llr,di1+1
	move fed+1,di1+2
	lac
	acst -slr,di1+4
	acst -slr+1,di2+4
	acst llr,di2+2
di1,	cla	repeat 4,xx
di2,	cla	repeat 4,xx
	llr fbg+1
	tra fes
	cal
dux,	tra acd
	movept
dul,	tra log

wck,	stz edc	|check for win - are all cards in pak7>>61<<.
	z=pk1	y=-10
	repeat 4,clad z	test y,ty2	z=z+1	y=y-13
	tra win

mmt,	slr mmx		|move detection sub
	amz u lro
isb,	trn spc		|no card - a space
	test -1,mmx	|no move - an ace
	test -11,.+5	|a valid card
	test -1,kng	|a king
	tra isb+1
	lac
	test -25,und
	sto tt
	test -13,a26
	tra und+5
a26,	addc 26
	tra und+5
sud,	acst 39,tt
	tra und+4
und,	test 13,sud
	acst 26,tt
	acst 13,tt+1
	load cpe+1,add up1
cpe,	cla
	adndo xx
	alm
	add tt
	tze pum
	lcc
	add tt+1
	tze pum
tog,	stptst cpe+1,add up7,cpe
mmx,	xx		|exit
pum,	move cpe+1,xx
	ado .-1
	sto .+3
	ado .-3
pui,	xx
	xx
	stz mov
	tra tog

kng,	move pui,kns-1
	slr .+1		|are there cards under king7>>61<<.
	llac xx
	search
	trn kns-1
	slr .+2
	clad xx
	donow
	trn mmx
	xx		|enter king
kns,	xx
	ado .-1
	tra mmx

spc,	move pui,.+2
	xx		|enter space
sps,	xx
	ado .-1
	tra mmx

fnd,	slr fnx	|sub to identify stk
octal	llrc 17777	decimal
	ana u com
	test st1,.+4
	cal u com
	tra fnx
	llrc -7
	ial
	test 1,.+4
	com u lro
	tra fnx
	ial
	test 13,.-6
	lac
	addc add dn1+6
	alr
	addc up1-dn1
fnx,	xx

|end of determine all possible plays

|TURN 3 CARDS: TX-0 SOLITAIRE

tr3,	load 0op,tra rek
	load tt,-2
	ado trc
	ado crd
	sto .+5
	add dnd
	trn .+2
0op,	xx	|if first pass, reorder dek
	check xx,tr3+5
1op,	opr
	load 0op,tra .+5
	llr .-5
	ado tt
	trn tr3+5
	slr crd
t3x,	tra acd
rek,	check mov,los
	load mov,-1
	slr trc
	stz mvc
	bk1crd
	trn wck
2op,	opr
	load crd,add dek-1
	tra tr3

|end of turn 3 cards

|PERFORM PLAY: TX-0 SOLITAIRE

per,	tra acd
	movept
rst,	tac u cyr
	trn mkm
	stz noc
1se,	check mv1,.+4
	tra .+4
	check mv1+2,2se
	acst ado-add,pr1
	clad crd
	acst llr-add,th1
	acst slr-llr,th1+3
	bk1crd
pr1,	xx	|reads ado upN
	acst slr-add,th1+1
th1,	move
	load xx,-1
	ado noc
2se,	check mv2,2sa
	acst ado-llr,.+2
	xx
	clad crd
	acst slr-add,.+3
	load xx,-1
	bk1crd
	ado noc
2sa,	load 2sb,llr mv2+2
2sb,	xx
	ado .-1
	ial
	trn 2nx
	acst ado-llr,p2a
	slr .+1
	llac xx
	trn err
	sto p2b
	acst -llr,p2c+2
p2a,	xx
p2b,	move xx,tt
	lac
p2c,	acst -1,p2e+1
	xx
	acst slr+1-add,.+3
	load xx,-1
	ado noc
	llrc tra 2nx
p2e,	check xx,idn
2nx,	stptst 2sb,llr mv2+9,2sb

	load 3se,llr mv3
3se,	xx
	ado .-1
	ial
	trn 3nx
	sto pr3+1
	slr .+1
	xx
	lac
	trn err
	sto tfm+1
	acst slr-add,tfm+4
	sto tt
pr3,	clad xx
	acst 1-add,tfm+3
	call tfl
3nx,	stptst 3se,llr mv3+18,3se

	load 4sa+3,add mv4+1
	load 4se+8,add mv4+5
4se,	check mv4,4sa
	acst llr-add,pr4
	acst slr-llr,pr4+3
	check xx,4ix
	acst slr-add,pr4+1
pr4,	move
	load xx,-1
	bk1crd
	ado noc
	ado 4se+8
	tra 4sa
4ix,	stptst 4se+8,add mv4+11,4se+7
	tra pxt
4sa,	move 4se+8,4sb+1
	check xx,4nx
	sto tfm+1
	acst slr-add,tfm+4
	sto tt
4sb,	check xx,4ox
	acst -add,tfm+3
	call tfl
	stptst 4sb+1,add mv4+11,4nx
	tra pxt
4nx,	stptst 4sa+3,add mv4+4,4sa+2
	tra pxt
4ox,	stptst 4sb+1,add mv4+11,4sb
pxt,	clad noc
	tze tr3
	modify mvc
pex,	tra des

err,	txtpnt ber,eor	|error in table
	tra dep

tfl,	slr tfx		|sub to transfer card run
	llrc -1
tfm,	check xx,tfn
	move
	ado tfm+1
	ado tfm+3
	ado tfm+4
	tra tfm
tfn,	call idn
	clad tfm+3
	acst add-1,tt
	search
	acst slr-add,.+3
	move tt,xx
	ado noc
tfx,	xx	|exit

idn,	slr tux		|sub to turn card on stk with blank
	clad tt
	search
	acst -add,tun-1
	addc -up1
	ial
	acst llr-add,tun
	acst ado-llr,tux-1
	lal	lad	cyl	cyl	lad
	acst st1,tun+4
	acst add,xx
tun,	move xx,.+3
	clad
	xx
	trn tux
	xx
tux,	xx

bk1,	slr lb1	|sub to move 1 card back in dek
	index crd,-1
	sto .+4
	test 1-add-dek,lb1+1
	check xx,bk1+1
lb1,	xx	|exit
	ado crd
	com
	tra lb1

|end of perform play and tape 2 - more to follow

start 
