******************** F.4.E2.LON ************************
**			                              **
**	       FOLL.4 Software to be stored in        **
**		     EPROM  at  $F000                 **
**                                                    **
**	        Written by Norman T. White            **
**		     Feb.,'80 - Feb.,'82              **
**			                              **
**	     Version used for installation at         **
**	          Canada House, London,               **
**	            Mar.24-Apr.20,'82                 **
**		                                      **
********************************************************

timer:  	equ	$2000		*fail-safe timer
rtimer: 	equ	$4000		*reset f.timer
iobase:		equ	$8000		*base address for all i/o
piad:		equ	$8008		*disk reader: in
*			 		  hdware timer: out
piac:		equ	$8009		*ctrl reg. for above
tmbits: 	equ	%11100000   	*1 = output
spkd:		equ	$800A		*speaker control data
spkc:		equ	$800B		*ctrl reg. for above.
aciac: 		equ	$8010		*serial port/motor ctrl
aciad:  	equ	$8011
comp:		equ	$8020		*comparator inputs.
compc:  	equ	$8021		*ctrl reg. for above
dac:		equ	$8022		*d/a conv. outputs
dacc:		equ	$8023		*ctrl reg. for above
nmiv:		equ	$a006
irqv:		equ	$a000
bega:		equ	$a002
enda:		equ	$a004
stack:  	equ	$a07f		*top of RAM stack

*references to f.4.e1
irqu:		equ	$f800
mcout:  	equ	$f80d
swait8  	equ	$f822
outss:  	equ	$f82a
pbox:		equ	$f831
hdec:		equ	$f84c
hddd:		equ	$f863
rndm:		equ	$f872
stim:		equ	$f891		*software timer
htim:		equ	$f89d		*hardware timer
shtim:  	equ	$f8a5		*start hdw. timer
roff:		equ	$f8b9		*quasi-div. of accA
init:		equ	$f8ca		*init. I/O, etc.
miclr:  	equ	$f90a		*IND clear
sirn:		equ	$f920		*sweep "siren"
jazz:		equ	$f93a		*<DLIT>-timed trill
gethp:  	equ	$f96e		*update HPOS
s1tape: 	equ	$f9a8		*Motorola punchdump
clrscr: 	equ	$f9fe		*clear console screen
pcrlf:  	equ	$fa06
prbyte: 	equ	$fa13
beep:		equ	$fa1e
multy:  	equ	$fa3e
divide: 	equ	$fa66
crlf:		equ	$dac0
msg1:		equ	$fac3
msg2:		equ	$fae0
msg3:		equ	$fafc		*S1 header
msg4:		equ	$fb01		*simple form-feed

*references to f.4.e3
vox:		equ	$e800
voxend: 	equ	$efff

*references to co-resident MINIBUG III
minib:  	equ	$fc44
outhl:  	equ	$fd18
outhr: 		equ	$fd1c
outch:  	equ	$fd26
pdata1: 	equ	$fd4b
out2hs: 	equ	$fd7e
outs:		equ	$fd9a
out2h:  	equ	$fd8d

*page one registers
beat:		equ	0
tone:		equ	1
tmpo:		equ	2
smoc:		equ	4		*save MOCO register
dirb:		equ	5		*cw/ccw flag for motors
moco:		equ	6		*composite motor ctrl
*			  	     	  word, where upper
*			  		   nybble : horiz., &
*			  		    lower nybble : vert.
hdst:		equ	7		*horiz. destination
*			 		 (uses l.s. 5 bits)
hpos:		equ	8		*present horiz. positon
hdlta:  	equ	9		*abs(HPOS-HDST)
vdst:		equ	$a		*vert. destination
vpos:		equ	$b		*present vert. position
vdlta:  	equ	$c		*abs(VPOS-VDST)
dlit:		equ	$d		*change in light level
dlitav: 	equ	$e		*average DLIT
loopct: 	equ	$f		*loop count for DLITAV cal.
savb:		equ	$10
xhi:		equ	$11
xlo:		equ	$12
vlim:		equ	$13
offst:  	equ	$14
temp:		equ	$15
mcont:  	equ	$16
dir2:		equ	$17		*backup directn bit
mask:		equ	$18
ctlsav: 	equ	$19		*pia-a ctrl reg. storage
hicell: 	equ	$1a		*MIND cell with highest score
locell: 	equ	$1b		* "    "    "   lowest    "
box0:		equ	$20		*results of a/d readings
*			  		  for (7) photocells
*			   		   and (1) potentiometer
exbox0: 	equ	$28		*former readings in above boxes
dlbox0: 	equ	$30		*corpesponding differences
*			       	  	  between boxes and ex-boxes
incfac: 	equ	$38		*increment factor for SCORE
xoffst: 	equ	$39		*value for X 'for-loop', SCORE
yoffst: 	equ	$3a		*  "    "  Y     "      "
xspec:  	equ	$40		*special register for
*			        	  pseudo-indexed addressing.
xspez:  	equ	$42		*another spec. register,
*			        	  but for Z-reg. addressing.
zreg:		equ	$44		*the great Z-REGISTER !
divsrh: 	equ	$50		*divisor
divsrl: 	equ	$51
divbfh: 	equ	$52		*division buffer
divbfl: 	equ	$53
dimh:		equ	$54		*diminuend
diml:		equ	$55
divndh: 	equ	$56		*dividend (result)
divndl: 	equ	$57
multc:  	equ	$58		*multiplicand
multp:  	equ	$59		*multiplier
prodh:  	equ	$5a		*product
prodl:  	equ	$5b
rnd:		equ	$fc		*random seed reg.'s
mind:		equ	$100
miend:  	equ	mind+$1df   	*end of mind's eye

*ASCII equivalents
nul:		equ	0
nulls:  	fcb	0,0,0		*pad for printout
eot:		equ	4
lf:		equ	$a
ff:		equ	$c		*form feed (screen clear)
cr:		equ	$d
sp:		equ	$20

*software constants
secno:  	equ	32		*no. of hopiz. sectors
*			 	        NOTE: if SECNO changed,
*				 	   then code in CELC and
*			 		    MDOUT subroutines
*			 		     must also be modified !
ms070:  	equ	$00		*hardware timer constants
ms140:  	equ	$20
ms280:  	equ	$40
ms560:  	equ	$60
sec1:		equ	$80
sec2:		equ	$a0
sec4:		equ	$c0
sec9:		equ	$e0

	org	$f000

*Add random displacements, between -3 and 3, 
* to both accumulators, so that accA falls 
*  in the valid HPOS range( 0 < HPOS < $1F, 
*   and accB in the VPOS range, 0 < VPOS < $F.
shftab: 	psha
shft0:  	jsr	rndm
		tsta
		bpl	shft1
		anda	#3
		nega
		bra	shft2
shft1:  	anda	#3
shft2:  	jsr	vadd
		bcs	shft0
		pulb
		psha
		jsr	rndm
		tsta
		bpl	shft3
		anda	#3
		nega
		bra	shft4
shft3:  	anda	#3
shft4:  	aba
		anda	#$1f
		pulb
		rts

*1 in 8 chance of modifying HDST,
* so that it points to the sector
*  which is opposite to the present one.
hrnd:		equ	*
		jsr	rndm
		anda	#$70		*0 - 7 in left nybble.
		cmpa	#$10   		*stimulus for about-face is
*			      	   	  also reversal factor,
*			      	    	   assuming 32 sectors.
		bne	hrnx		*if matched, then
		tab			* add to HPOS
		jsr	gethp
		aba
		anda	#$1f
		staa	hdst
hrnx:		rts

*scan vertically to VDST.
vpnt:		tst	rtimer  	*reset failsafe timer.
		psha
		pshb
		ldab	#sec9		*set timer for about 9 sec.
		jsr	shtim		* (2nd failsafe system).
vpt1:		jsr	look		*get pot reading
vpt2:		clr	dirb
		ldaa	vpos
		suba	vdst
		beq	vptx		*exit if no difference
		bhi	vpt3
		nega
		inc	dirb
vpt3:		ldab	#2
		cba
		bls	vpt4
		ldab	#4
		cba
		bls	vpt4
		ldab	#6
vpt4:		tba
		oraa	dirb
		jsr	aout
		tst	piac		*if timer done, exit.
		bpl	vpt1
vptx:		bsr	vstop		*stop motor
		pulb
		pula
		rts

*output stop-MOCO to motors
*and repeat until VPOS stable
vstop:  	psha
		pshb
		ldaa	vpos
vstp0:  	psha
		clr	moco
		jsr	mcout		*stop motor
		ldab	#ms560 		*wait 1/2 sec.
		jsr	htim
		jsr	look
		ldaa	vpos		*see that
		pulb			* VPOS hasn't changed
		cba
		bne	vstp0		*re-loop till VPOS stable
		pulb
		pula
		rts

*output MOCO from accA, then delay 1/4 sec
daout:  	psha
		oraa	dirb
		jsr	aout
		ldaa	#$ff	*set software timer
		jsr	stim	*for full delay
		pula
		rts

*straight MOCO output from accA
aout:		staa	moco
		jsr	mcout
		rts

*get HDLTA subroutine:
*Enter with valid HDST
*Gets HPOS directly
*Exits with HPOS, DIRB, and HDLTA updated.
gdlta:  	psha
		pshb
		clrb
		jsr	gethp
		suba	hdst
		bita	#$10
		beq	gdlt0
		ldab	#$10
		nega
gdlt0:  	stab	dirb
		anda	#$1f
		staa	hdlta
		pulb
		pula
		rts

*calculate MOCO
*Enter with valid HDST
*Exit with HPOS, HDLTA, and MOCO updated.
hcal:		jsr	gdlta
		ldaa	hdlta		*get ABS(HPOS-HDST)
		cmpa	#1		*consider HPOS = HDST
		bgt	hca0		* if HDLTA < 2.
		clra			*stop code
		bra	hcax
hca0:		ldab	dirb
		cmpa	#3
		bgt	hca1
		ldaa	#$20		*slow speed
		bra	hca3
hca1:		cmpa	#7
		bgt	hca2
		ldaa	#$40		*med. speed
		bra	hca3
hca2:		ldaa	#$60		*fast speed
hca3:		aba			*add directn bit
hcax:		staa	moco
		rts			*accA = new MOCO
		swi			*bug trap

*scan horiz. till HPOS matches HDST.
hpnt:		tst	rtimer  	*reset failsafe timer.
		psha
		pshb
		ldab	#sec9		*set hdw. timer = 9 sec.
		jsr	shtim		*for 2nd failsafe system.
hpt0:		jsr	hcal		*if HPOS near HDST
		tst	moco		*signalled by MOCO = 0
		beq	hpt1		*then exit from loop
		jsr	mcout		*else send out MOCO
		tst	ctlsav 	 	*check this because HCAL
		bmi	hpt1		* could reset CRA-7.
		tst	piac		*short-term failsafe timer.
		bpl	hpt0		*keep on if timer running
hpt1:		jsr	hstop
		pulb
		pula
		rts

*output stop-MOCO to motors
*and repeat until HPOS stable.
hstop:  	psha
		pshb
		ldab	#sec9		*set timer for 9 sec.
		jsr	shtim
		ldaa	#$10		*calculate low-speed
		eora	dirb		*reverse of present
		oraa	#$20		*direction
		bsr	daout		*short burst of this.
		jsr	gethp
hstp0:  	tab			*save old HPOS
		clra			*stop MOCO
		jsr	daout
		jsr	gethp		*see that
		cba			* HPOS hasn't changed.
		beq	hstpx		*exit if HPOS stable.
		tst	piac		*timer done ?
		bpl	hstp0
hstpx:  	pulb
		pula
		rts

*horiz.sector verificatn signal
mark:		ldaa	#$20
		staa	tmpo
		ldaa	hpos
		asla	        	*multiply by 2
		adda	#$40    	*add to base figure.
		staa	tone
		jsr	beep
		rts

*Enter with accA and accB containing valid
* horiz. and vert. position codes, respectively, 
*  and attempt to scan to designated position.
gothar: 	staa	hdst
		stab	vdst
		jsr	hpnt
		jmp	vpnt

*generate new HDST and VDST according to 
* which photocell picks up the greatest 
*  amount of light-change.
*Enter with XR containing address of
* DLBOX cell with largest data byte.
track:  	stx	xhi
		ldaa	xlo
		suba	#$30    	*get right nybble
		asla	        	*multiply by 2
		ldx	#shftbl 	*and add to base
		jsr	axx     	*  addr. of table.
		ldaa	0,X
		adda	hpos
		anda	#$1f
		staa	hdst
		ldab	vpos
		ldaa	1,X
		jsr	vadd
		bcs	tracx
		staa	vdst
tracx:  	rts

*add accA to Index register
axx:		psha
		stx	xhi
		adda	xlo
		staa	xlo
		bcc	ax1
		inc	xhi
ax1:		ldx	xhi
		pula
		rts

* print 'mind' on screen
* so room prints upright.
* employ 'sliding scale' for
* correlating activity reading
* with character intensity.
*NOTE: only one character is
* printed per horiz. sector,
* so 32 sectors is assumed.
mdout:  	ldaa	#ff		*clear screen
		jsr	outch
	l	dx	#miend
		ldab	#$ff		*get lowest reading.
mdou0:  	ldaa	0,X
		cba
		bhi	mdou1
		tab
mdou1:  	dex
		cpx	#mind-1
		bne	mdou0
		stab	locell
		inx
		clrb			*get highest reading.
mdou2:  	ldaa	0,X
		cmpa	#$ff		*ignore initialized
		beq	mdou3		* data pattern.
		cba
		bls	mdou3
		tab
mdou3:  	inx
		cpx	#miend+1
		bne	mdou2
		stab	hicell
		subb	locell
		stab	divsrl  	*store difference.
		clr	divsrh
		dex
mdou4:  	stx	xhi
		ldaa	0,X		*get light data.
		beq	mdou7		*if virgin cell, then
*				          skip calculatns.
mdou5:  	suba	locell  	*calculate
		staa	diml		* fraction of
		clr	dimh		*  current total
		ldab	#4		*   range, in terms
		clc
mdou6:  	asl	diml		*    of a value, 0-15.
		rol	dimh
		decb
		bne	mdou6
		jsr	divide
		ldaa	divndl  	*result of divisn
		ldab	divbfl  	*remainder
		aslb		 	*round-off 
		cba
		bhi	mdou7
		inca
mdou7:  	ldx	#chrtbl-1  	*use this value
mdou8:  	inx			* to find approp. char,
		deca
		bpl	mdou8
		ldaa	0,X
		jsr	outch
		ldx	xhi
		dex
		cpx	#mind-1
		bne	mdou4
		rts

*Find Coordinates corresponding to MIND cell addr., 
* given by the Index Register.
*Exit with X in accA, and Y in accB
getxy:  	stx	dimh
		ldaa	dimh
		suba	#1      	*m.s.byte of MIND addr.
		staa	dimh
		clr	divsrh
		ldaa	#secno
		staa	divsrl
		jsr	divide
		ldab	divndl
		ldaa	divbfl
		rts

*New, more general CELOC
* CELL = MIND + (Y * 32) + X
*  where 0 <= X = accA <= 31,
*   an` 0 <= Y = accB <= 15 .
*EXit with result in Index Register.
celoc:  	psha
		pshb
		ldx	#mind
		aslb
		aslb
		aslb
		aslb
		bcc	celo1
		psha
		ldaa	#$ff    	*add $100 to XR
		jsr	axx
		inx
		pula
celo1:  	aba
		jsr	axx
		pulb
		pula
		rts

*Generalized Data-Sort routine:
* Enter with start of Memory Block in BEGA 
*  and end of same (+1) in ENDA.
* Exit with largest byte (unsigned) in accA, 
*  and address of same in Index Register
gethi:  	ldx	bega
gthi0:  	ldaa	0,X
		stx	xhi
gthi1:  	inx
		cpx	enda
		beq	gthix
		cmpa	0,X
		bhi	gthi1
		beq	gthi1
		bra	gthi0
gthix:  	ldx	xhi
		rts

*Find Photocell of greatest change
hipcel: 	ldx	#dlbox0
		stx	bega
		ldx	#dlbox0+7
		stx	enda
		bra	gethi

*find MIND cell with highest data
himind: 	ldx	#mind
		stx	bega
		ldx	#miend+1
		stx	enda
		bra	gethi

*Add accA and accB, and
* set Carry flag if NOT( 0 < SUM < $F ).
vadd:		pshb
		psha
		aba
		bmi	vad0
		cmpa	#$f
		clc
		ble	vad1
vad0:		sec
		pula
		bra	vadx
vad1:		pulb
vadx:		pulb
		rts

*'Humpwise' increment of Activity Map (MIND) 
* relative to present HPOS and VPOS:
score:  	ldaa	#$fe
scor0:  	staa	xoffst
		ldab	#$fe
scor1:  	stab	yoffst
		bpl	scor2
		negb
scor2:  	tsta
		bpl	scor3
		nega
scor3:  	jsr	max
		suba	#3
		nega
		staa	incfac
		ldaa	vpos
		ldab	yoffst
		jsr	vadd
		bcs	scor4
		staa	temp
		ldaa	hpos
		ldab	xoffst
		aba
		anda	#$1f
		ldab	temp
		jsr	celoc
		ldaa	incfac
		adda	0,X
		staa	0,X
scor4:  	ldaa	xoffst
		ldab	yoffst
		incb
		cmpb	#3
		bne	scor1
		inca
		cmpa	#3
		bne	scor0
		rts

*decrement all activity registers
* now located in MIND
fade:		equ	*
		ldx	#mind		*decr. all activity regs.
fad0:		ldaa	0,X
		suba	#1		*don't replace with DEC,
		staa	0,X		* since carry flag req'd
		bcc	fad1		*  to disallow underflow.
		inc	0,X
fad1:		inx
		cpx	#miend
		bne	fad0
		rts

*Routines for transferring old photocell data
* to a second matrix, and loading a 3rd matrix 
*  with the absolute differences between the 
*   first two.
copybx: 	ldx	#box0
copyb0: 	ldaa	0,X
		staa	7,X
		inx
		cpx	#box0+8
		bne	copyb0
		rts

dltabx: 	ldx	#box0
dltab0: 	ldaa	0,X
		ldab	8,X
		jsr	max
		sba
		staa	$10,X
		inx
		cpx	#box0+7
		bne	dltab0
		rts

*after entering SR with 2 unsigned values in 
*accA and accB, exit with larger in accA
max:		cba
		bhi	mx1
		staa	temp
		tba
		ldab	temp
mx1:		rts

*new LOOK, featuring succ. approx. algorithm: 
*reads (7) photocells + (1) potentiometer 
*Also saves former set of readings in XBOX's 
*and stores diff. between new and old set 
*of data in DLBOX's. 
*Finally, VPOS, in 0-$F range, updated.
look:		psha
		pshb
		jsr	copybx 		*save previous readings
		ldx	#box0
		ldaa	#1		*initialize comparator mask
		staa	mask
loo0:		clra
		ldab	#$80		*initializm bit mask
loo1:		aba
		staa	dac
		nop
		nop			*delay for settling time.
		nop
		ldaa	comp
		anda	mask
		bne	loo2
		ldaa	dac
		sba			*delete trial bit
		bra	loo3
loo2:		ldaa	dac
loo3:		rorb
		bcc	loo1
		staa	0,X
		inx
		asl	mask
		bcc	loo0		*on 8th read, carry set
		jsr	vconv		*convert pot reading
		jsr	dltabx  	*calc. DLBOX's
		pulb
		pula
		rts

*Convert potentiometer reading in accA to
* valid VPOS, where 0 < VPOS < $F
vconv:  	suba	#$20
		bcc	vcon0
		clra
		bra	vcon1
vcon0:  	ldab	#3
		jsr	roff
		cmpa	#$f
		bls	vcon1
		ldaa	#$f
vcon1:  	staa	vpos
		rts

main:		lds	#stack
		nop
		sei
		tst	timer		*enable failsafe timer.
		jsr	miclr
mn0:		jsr	init
mn1:		jsr	look
		jsr	hipcel
		cmpa	#3
		bhi	mn2
		jsr	himind
		jsr	getxy		*shift scanner
		jsr	shftab  	*either slightly,
		jsr	hrnd		* or about-face.
		jsr	gothar
		bra	mn3
mn2:		cpx	#dlbox0 	*center photocell ?
		bne	mn4
		staa	dlit		*yes; respond aurally,
		jsr	jazz
		jsr	score		* and increment score.
mn3:		jsr	fade
		bra	mn1		*re-loop.
mn4:		jsr	track		*else calculate new HDST/VDST
		jsr	gothar  	* and attempt to track motion.
		bra	mn1

		swi
		swi
		swi
		swi
		swi
		swi			*spare room for
		swi			* MAIN expansns.
		swi
		swi

******************* TABLES **********************
shftbl:	 equ	*
		fcb	0,0,$ff,3,$fe,0,$ff
		fcb	$fd,1,$fd,2,0,1,3
		fcb	0,0,0,0	*extras

*character table for MDOUT
chrtbl: 	fcc	/  .,;!>YXUOQ8BE[[/

*message table
*all messages stored in f.4.e1

		end