TX-0 SOLITAIRE: Tape 3 - Mechanics of play (con1t)

|CARD PRINTING ROUTINES: TX-0 SOLITAIRE

cpt,	slr out	|one card printing sub
	amz u lro
	trn .+3
	test -52,cpa
	txtpnt fnt-1,fnt
	tra cpb
cpa,	slr tm1
	stz tm2
	llr ten-1
	test 26,blk
	tra rad
cpc,	ado tm1
	test -2,ase
	tst0 -9,ten
	test -3,rgc
	sto tm1
	ado tm2
	tra cpc
ten,	add fnt+1
	pno
	addc -14
ase,	addc 1
rgc,	adndo (add fnt+13
	tm1=.-1
	pno
	addc add tb2
	adndo tm2
	tm2=.-1
	pno
cpb,	1tblat
out,	xx	|exit

blp,	slr tt+1	|block card printing sub
	load tt,-7
	cla
blc,	xx
	1cdpnt
	ado blc
	add tt+1
	tze blg
	ado tt
	trn blp+3
blg,	carret
	add tt
	trn .+2
	tra blp+1
	call blk
	cal
blx,	xx	|exit

dkp,	slr lxt	|deck printing sub
	txtpnt bdk,bsp
	crdpnt mec+1,mec+52
lxt,	xx	|exit

sts,	tra acd	|status routine
spt,	slr wef		|print status
	txtpnt bsp,1sp
	load ppk+1,tra 1pk
ppk,	call xx
	trn .+3
	1cdpnt
	idxtst ppk+1,2pk-1pk,tra 4pk,ppk
	txtpnt 1sp,2sp
	load pss+1,add st1
	load pst+1,add up1
pss,	clad
	1cdpnt
	idxtst pss+1,13,add st7,pss
	clac char r
+char m	
	print
pst,	cla
	adndo xx
	1cdpnt
	stptst pst+1,add up7,pst
psd,	move crd,.+3
	clad
	alm
	add yy+4
	tze ped
	slr yy+4
	txtpnt 2sp,esp
	add yy+4
	1cdpnt
ped,	txtpnt 2sp,3sp
wef,	xx	|exit

1pk,	slr 1px		|pak searching subs
	schpak 0,0
1px,	xx
2pk,	slr 2px
	schpak 1,13
2px,	xx
3pk,	slr 3px
	schpak 2,26
3px,	xx
4pk,	slr 4px
	schpak 3,39
4px,	xx

|display routines

octal
std,	slr wef	|display status
	size 2
	call 1pk
	sto 1tm
	call 2pk
	sto 2tm
	call 3pk
	sto 3tm
	call 4pk
	sto 4tm
	cla
	move crd,.+2
	xx
	sto 5tm
	stz tt+4
sad,	ado tt+4
	com
	load 17,5
	add 17
	tze .+2
	trn wef	|exit
	load sbd,add 1tm
	load scd,llr cor
	load sdd,llr cos
	load tt+2,add st1
	clc
sbd,	xx
	trn .+5
scd,	move xx,tt
	call cdp	|display pak or dek card
	ado scd
	stptst sbd,add 5tm,sbd-1
sdd,	move xx,tt
	move tt+2,sed
	clc
sed,	xx
	trn sfd
	call cdp	|display stk card
	clad tt	|index Y coordinate
	llrc -777
	alp
	addc -36
	cll u lad
	sto tt
	ado sed
	tra sed-1
sfd,	ado sdd
decimal	idxtst tt+2,13,add st7,sdd
	tra sad

cdp,	slr cdx	|card display sub - basept in tt
	all
	lad
	acst add dst-3,cdl+1
	load tt+1,-2
	basept tt
cdl,	check xx,cdx
	plot
	ado cdl+1
	ado tt+1
	trn cdl
cdx,	xx	|exit

octal	|win-lose display
eds,	stz tt+3
	size 7
cnd,	ado tt+3
	com
	load 17,5
	repeat 2,add 17
	tze .+2
	trn tec
	load tt+2,-3
	clad tt
	llrc llr ell
	trn .+2
	llrc llr duw
	slr tt+1
	basept (627000
wld,	clad tt+1
	plot
	repeat 3,ado tt+1
	ado tt+2
	trn wld
	addc -3000
	test 1,.
	tra cnd

|display tables

define	coor X,Y
	repeat 9,X=X+X
	X+Y
	term

decimal
cor,	coor 511-218,223	|1st pakcrd
	coor 511-88,223	|2nd pakcrd
	coor 42,223	|3rd pakcrd
	coor 172,223	|4th pakcrd
	coor 511-50,511-223	|dek card
cos,	coor 511-193,162	|1st stkcrd
	coor 511-128,162	|2nd stk
	coor 511-63,162	|3rd stk
	coor 2,162	|4th stk
	coor 67,162	|5th stk
	coor 132,162	|6th stk
	coor 197,162	|7th stk

|card character table

	l=llr

dst,	l ace	l spd	-0
	l two	l spd	-0
	l tre	l spd	-0
	l for	l spd	-0
	l fiv	l spd	-0
	l six	l spd	-0
	l svn	l spd	-0
	l ate	l spd	-0
	l nin	l spd	-0
	l one	l zer	l spd
	l jak	l spd	-0
	l qen	l spd	-0
	l kig	l spd	-0

	l ace	l clb	-0
	l two	l clb	-0
	l tre	l clb	-0
	l for	l clb	-0
	l fiv	l clb	-0
	l six	l clb	-0
	l svn	l clb	-0
	l ate	l clb	-0
	l nin	l clb	-0
	l one	l zer	l clb
	l jak	l clb	-0
	l qen	l clb	-0
	l kig	l clb	-0

	l ace	l hrt	-0
	l two	l hrt	-0
	l tre	l hrt	-0
	l for	l hrt	-0
	l fiv	l hrt	-0
	l six	l hrt	-0
	l svn	l hrt	-0
	l ate	l hrt	-0
	l nin	l hrt	-0
	l one	l zer	l hrt
	l jak	l hrt	-0
	l qen	l hrt	-0
	l kig	l hrt	-0

	l ace	l dia	-0
	l two	l dia	-0
	l tre	l dia	-0
	l for	l dia	-0
	l fiv	l dia	-0
	l six	l dia	-0
	l svn	l dia	-0
	l ate	l dia	-0
	l nin	l dia	-0
	l one	l zer	l dia
	l jak	l dia	-0
	l qen	l dia	-0
	l kig	l dia	-0

	l=-0

|character table

octal
spd,	 34170	377377	170034	
clb,	 30074	-0	 74030	
hrt,	 60174	 37037	174060	
dia,	 34076	177177	 76034	
zer,	577200	600600	200577	
one,	400440	500777	400400	
two,	443504	504504	504470	
tre,	501200	610610	224543	
for,	 10030	450510	777400	
fiv,	761210	610610	210707	
six,	577210	610610	210507	
svn,	700201	206210	260300	
ate,	567210	610610	210567	
nin,	561210	610610	210577	
ace,	177610	210210	610177	
jak,	403000	200777	200000	
qen,	176201	205203	601176	
kig,	377410	 24042	501200	
duw,	477001	  6006	  1477	
	400040	477440	     0	
	 77420	 10004	402077	
	400076	 76400	     0	
ell,	777400	400400	400400	
	577200	600600	200577	
	563210	610610	210505	
	777610	610610	600600	

decimal
|end of display routines

|move print

mvp,	slr gob
	txtpnt bmp,bma
c1h,	stz noc
	load cp1,llr mv1
	load cp2,add fnt+1
	load cp3,llr cp3
	load cp4,add (-llr-mv1-3
	call cmn
c2h,	load c2p+1,add mv2
	load c2q,opr
	stz tt+4
c2p,	check xx,c2w
	clad fnt+2
	call pth
c2q,	xx
	txtpnt 3sp,esp
	llac mv2+1
	trn c2t+2
	sto c2u
	tra c2u
c2t,	clad xx
	llrc tra c2s
	trn erp
	sto c2u
	addc add-llr
	call fpk
c2u,	move xx,.+3
	clad xx
c2v,	call ctb
	txtpnt pkp,pke
c2s,	carret
	ado noc
c2w,	load c2q,tra c2t
	repeat 2,ado tt+4	ado c2p+1
	sto c2t+1
	stptst c2t+1,add mv2+8,c2p
c3h,	load cp1,llr mv3
	repeat 2,ado cp2
	load cp3,tra fdt
	load cp4,add (-llr-mv3-19
	call cmn
c4h,	load c4p+1,add mv4
	load c4q,opr
	stz tt+4
	load c4p+4,llr mv4+5
c4p,	check xx,c4t
	sto c4s
	llcc xx
	trn c4u
	stptst .-3,llr mv4+11,.-3
	tra amv

c4u,	clad fnt+4
	call pth
c4q,	xx
	txtpnt 3sp,esp
	move mv4,c4s
	tra c4s
c4w,	3tblat
c4r,	add c4s
	call fdt
c4s,	xx
	call ctb
	carret
	load noc,1000
c4t,	load c4q,tra c4r
	ado tt+4
	ado c4p+1
	test -add-mv4-4,c4p
	load c4q,tra c4w
	alo
	add noc
	test -1000+1,amv
	lac
	test -7,c4p
amv,	clad noc
	tze gob+1
	cal
gob,	xx	|exit
	txtpnt bno,eno
	move gob,wef
	tra psd

cmn,	slr cmx
	stz tt+4
cp1,	xx
	ado .-1
	ial
	trn cmr
	slr cmo
	sto cmq
	cla
cp2,	xx
	call pth
cmo,	llac xx
	llrc tra cms
	trn erp
	sto cmp
	llrc tra cmp
cp3,	txtpnt 3sp,esp
cmp,	xx
	call ctb
	1tblat
	add cmq
	call fpk
cmq,	adndo xx
	call ctb
cms,	carret
	ado noc
cmr,	ado tt+4	ado tt+4
	ado cp1

cp4,	xx
	trn cp1
cmx,	xx	|exit

fdt,	slr git
	subr fnd,.+3
fpk,	slr git
	adndo (stp-up1
	print
	1tblat
git,	xx

pth,	slr ptx
	pno
	add tt+4
	tze .+4
	indcpt sdn
	2tblat
ptx,	xx

ctb,	slr ctx
	1cdpnt
	call blk
ctx,	xx

erp,	slr erq
	txtpnt erb,erx
erq,	xx

|end of move print - end of card printing routines

|MAKE MOVE: TX-0 SOLITAIRE

mkm,	load dix,opr	|manual play routine
	load apl,tra ls
	slr acr
	stz tt
	carret

octal
ls,	load ls0,add dpt
	cal
lsn,	lcc
	trn .-1
ls0,	xx
	trn ls1
lsi,	stptst ls0,add acd-1,lsn
	tra ls
ls1,	test 400,lsi
	test -12,dix-1
	acst tra dpt+12,.+3
	clc
	xx

dpt,	number 76,0	|dispatch table
	number 25,1
	number 17,2
	number 7,3
	number 13,4
	number 23,5
	number 33,6
	number 27,7
	number 3,8
	number 66,9
	routine 77,acd
	routine 51,acr
	routine 15,apl
	routine 54,ap
	routine 70,am
	routine 22,ad
	routine 12,ast
	routine 16,au
	routine 62,ab
	routine 45,acr	|tab
	routine 43,acr	|back space
	routine 34,ac
	routine 44,al
	routine 32,af
	routine 74,av
	routine 40,at

decimal
acd,	call rad
	addc flex xo
	print
ams,	call rad
	addc flex xox
	print
	call blk
	tra mkm

	addc 9
dix,	xx
	trn ls
	test -4,.+3
	tra ls
	acst add mvt,acr+1
	load acr,opr
	slr apl
	tra ls

sch,	sto tt
	load dix,tra .+3
	tra ls

	acst 10,tt
	tra ls

apl,	xx
	load dix,tra sch
	load apl,tra ls
	tra ls

acr,	move
	add tt
	sto .+5
	com
	test slr mv4+12,acd
	load xx,-1
	tra mkm

ap,	load acr,tra rst+2
	tra ls

ast,	load acr,tra .+3
	tra ls
	status
	tra mkm

am,	load acr,tra .+3
	tra ls
	movept
	tra mkm

ad,	load acr,tra dep
	tra ls

au,	load acr,tra .+3
	tra ls
	load wef,tra mkm
	stz yy+4
	tra psd

ab,	load acr,tra mst
	tra ls

al,	load acr,tra .+3
	tra ls
	check loi,ams
	cal
	tra log

ac,	load acr,tra .+3
	tra ls
	load msx,tra .+3
	tra mst
	load msx,tra shf
	tra mkm

av,	load acr,tra .+3
	tra ls
	subr std,mkm

at,	load acr,tra .+3
	tra ls
	subr spt,mkm

octal
af,	load acr,tra 14000
decimal	tra ls

	slr mv1
	slr mv2
	slr mv3
mvt,	slr mv4

|end of make move

|EXIT ROUTINE: TX-0 SOLITAIRE

win,	ado wns
	sto tt
	call mck
	txtpnt bwn,ewn
	tra tec
los,	sto tt
	call mck
	txtpnt bls,els
tec,	ado gms
	alm
	add yy+2
	tze .+6
	tac u cyr
	trn mkm
	cyr u com
	trn mst
	tra .+2
	slr yy+2
	txtpnt bex,ee1
xpt,	opr
skl,	txtpnt be3,ee3
	add wns
	indcpt mds
	txtpnt be4,ee4
	add gms
	indcpt mds
	txtpnt be5,ee5
	ratiopnt wns,gms
skm,	clac char r
	repeat 3,prt
sme,	opr
	tac u cyr
	cyr	cyr
	trn mst
fin,	xx	|halt - play is completed
	txtpnt bti,eti	|print new title
	tra res		|reset counters and continue play

mck,	slr mcx
mcj,	opr
	clad des
	test add,tec
	clad sts
	test add,eds
mcx,	xx

|end of exit routine

|STORAGE AREA: TX-0 SOLITAIRE

mec,	mec	|indicates mechanics tape loaded
dek=.	dek+53|
pak,	beg,
st1,	st1+13|
st2,	st2+13|
st3,	st3+13|
st4,	st4+13|
st5,	st5+13|
st6,	st6+13|
st7,	st7+12|
to1,	to1+1|
to2,	to2+2|
to3,	to3+3|
to4,	to4+4|
to5,	to5+5|
to6,	to6+6|
to7,	to7+7|
mov,	0	|negative if move not possible since last reorder
		|0 if possible
edc,	0	|0 when no cards left in deck - negative otherwise
crd,	0	|deck card pointer
up1,	0	|stack card pointers
up2,	0
up3,	0
up4,	0
up5,	0
up6,	0
up7,	0
dn1,	0	|down card pointers
dn2,	0
dn3,	0
dn4,	0
dn5,	0
dn6,	0
dn7,	0
trc,	0	|count of number of times thru tr3 since
		|last reorder
mvc,	0	|count of moves made since last reorder
mv1,	mv1+4|	|move table
mv2,	mv2+10|
mv3,	mv3+20|
mv4,	mv4+12|
noc,	0
tt,	tt+5|	|temporary storage
dnd,	-add-dek-51	|end of deck check
yy,	0	trn	yy+5|	|semi-permanent storage
lat,	-brn	|end of random number storage pointer
loi,	xx	|logic tape indicator
wns,	0	|win counter
gms,	0	|game counter
brn,	brn+65|	|random number storage
	ern=.-1

bti,	text .
TX-0 SOLITAIRE
.	eti=.
blm,	text .
Logic tape not loaded
.	elm=.
stp,	text .st1st2st3st4st5st6st7.
tb2,	text .s  c  h  d  X.
fnt,	char r0	char r1	char r2	char r3
	char r4	char r5	char r6	char r7
	char r8	char r9	char r0	char rj
	char rq	char rk	char ra
bmp,	text .
Plays
.	bma,

bdk,	text .
Deck
.
bsp,	text .
Status
pak	.
1sp,	text .
stk	.
2sp,	text .
.	3sp,	text .dek	.
	esp=.
pkp,	text .	pak.	pke,
bno,	text .none.	eno,
ber,	text .
An error has been found in the table of plays
.	eor=.
erb,	text .error.	erx,
bwn,	text .
win
.	ewn=.
bls,	text .
lose
.	els=.
bex,	text .

SUMMARY
.	ee1=.
be2,	text .	logic:		.	ee2=.
be3,	text .
	games won:		.	ee3=.
be4,	text .
	games played:		.	ee4=.
be5,	text .
	fraction won:		.	ee5=.

|end of storage area

|SOME LOGIC SUBROUTINES: TX-0 SOLITAIRE

dwn,	slr dwx	|find number of down cards on stK
	stz tt	|enter with c(ac)=add upK
	acst llr dn1-add-up1,.+2
	move xx,.+3
dwo,	check xx,dwl
	ado .-2
	ado tt
	tra dwo
dwl,	llac tt
dwx,	xx	|exit

mvs,	slr mvx	|set up table consisting of all moves
	com	|involving stN	|enter with c(ac)=add upN
	sto tt
	llrc -1
	z=0	repeat 8,slr mt1+z	z=z+1
	clad mv1
	add tt
	tze 1v0
	clad mv1+2
	add tt
	tze 1v1
2tr,	load 2ta+1,add mv2+3
2ta,	clad
	addc add-llr
	add tt
	tze 2v0
2tb,	ado 2ta+1
	stptst 2ta+1,add mv2+9,2ta
3tr,	load 3ta+1,add mv3
	load 3v0+1,slr mt3
3ta,	clad
	add tt
	tze 3v0
3tb,	idxtst 3ta+1,2,add mv3+18,3ta
	load 3tc+1,add mv3+1
	load 3v2,slr mt4
3tc,	check xx,3td
	search
	add tt
	tze 3v1
3td,	idxtst 3tc+1,2,add mv3+19,3tc
4tr,	load 4ta+1,add mv4+1
	load 4v0+1,slr mt5
4ta,	check xx,4tb
	search
	add tt
	tze 4v0
4tb,	stptst 4ta+1,add mv4+4,4ta
	load 4v0+1,slr mt6
	test -7,4ta
	cal
mvx,	xx	|exit

1v1,	llrc add mv1+2
	tra .+2
1v0,	load mt1,add mv1
	tra 2tr
2v0,	add 2ta+1
	acst -1,mt2
	tra 3tr
3v0,	move 3ta+1,xx
	ado .-1
	tra 3tb
3v1,	lda 3tc+1
	acst -1,.+3
	alo
	xx
	trn 3td
3v2,	xx
	ado .-1
	tra 3td
4v0,	move 4ta+1,xx
	tra mvx-1

rsr,	slr tt+2
	sto tt+3
	call bit
	llr tt+2
	trn .+2
	llr tt+3
fle,	lac
	tra .+2
fls,	slr rsx
octal	llrc 17777
	ana
	acst slr,.+3
	load xx,-1
	slr i1
rsx,	xx

decimal

cnf,	slr cnx	|check for conflicts - dispatch to resolving
cne,	check mv1,caf	|subroutines
	check mv1+2,cbf
	call acj		|type A conflict present
caf,	load ind,-1
	llr .+2
	check mv1+2,cbf
	tra crf
cbf,	llr .+2
	check mv1,ccf
	sto ind
crf,	slr t1
	check mv2,cef
	call ecj		|type E conflict present
	check ind,cbf
ccf,	check mv4,cef
	check mv2,cef
	call gcj		|type G conflict present
cef,	load upt,add up1
cnc,	clad upt
	call mvs
	check mt1,csf
	check mt2,csf
	call jcj		|type J conflict present
csf,	check mt4,cmf
	check mt4+1,cff
	call bcj		|type B conflict present
cff,	load ind,-1
	check mt2,cmf
	sto clf+5
	clad ind
	tze ckf
	tpos cmf
	check mt4,ckf
	stz ind
clf,	sto t1
	adndo (1
	xx
	ial
	trn cmf
	donow
	lcd
	llr .+2
	tze icj		|type I conflict present
	tra cff+2
ckf,	check mt4+1,cmf
	sto ind
	tra clf
cmf,	check mt1,cgf
	check mt3,cif
	subr dcj,cof	|type D conflict present
cgf,	check mt3,cqf
	check mt3+1,cof
	call ccj		|type C conflict present

cof,	load ind,-1
	clad mt3
	tpos chf
cqf,	check mt3+1,cif
	sto ind
chf,	sto t1
	check mt2,cjf
	call fcj		|type F conflict present
	check ind,cqf
cif,	check mt5,cjf
	check mt2,cjf
	call hcj		|type H conflict present
cjf,	stptst upt,add up7,cnc
cnx,	xx	|exit

	variables
	constants

|end of some logic subroutines
lcg=.+10	|logic base

|INPUT ROUTINE: TX-0 SOLITAIRE

beg|	clad beg-1
	tst0 -beg,beh	|has a title been printed7>>61<<.
	txtpnt bti,eti	|print a title
	load beg-1,beg	|indicate title has been printed
beh,	llrc 1
	add lcg
	tst0 -lcg,bei	|is logic tape loaded7>>61<<.
	txtpnt blm,elm	|logic not loaded
	load gmc,-1
bei,	slr loi
	tra rrn

	constants

|end of input routine - end of tape 3 - end of mechanics of play

start beg
