;USR0:<BUDD>VTTREK.MAC.7  7-Mar-85 FM+1D.19H.44M.15S., by BUDD
; Make LINK with FORTRAN v7 + remove some once only kludgery
;<HESS>VTTREK.MAC.31  8-Jan-81 09:09:14, Edit by HESS

TOPS20==1			;[BUDD]

;	VT100 TREK Version 2.0
;
;	TREK is a VT100 game for up to eight players.  It's written in
;	MACRO-10 for VT100s that are equipped with the Advanced Video
;	Option.
;
;	Each player runs the game from a separate tty and job.  The
;	jobs communicate via a sharable high segment.
;
;	TREK.RNO contains a complete game description.  The program
;	uses a file of help texts named TREK.HLP.  This file should be
;	on the same device in the same ppn as the TREK.EXE.  The file isn't
;	required in order to run the game.
;
;	Version 2.0 contains all of the modifications since the release
;	of Version 1.0 plus many new routines.  TREK.RNO describes
;	Version 2.0 and the differences between the old and new versions.
;
;	TREK timing is based on 1200 baud lines.  Lower baud rates give a
;	slow-motion effect and an advantage to interceptors and bases.  There
;	has been no opportunity to test the program at higher baud rates.
;
;	Questions, comments, suggestions, etc, are welcome.
;
;	For further information, contact:
;	
;		Cliff Zimmerman
;		Manufacturing Planning Information Systems
;		ML1-4, F16
;		223-6294 ((617)-493-6294)
; 
;	Revisions since release of version 1.0:
;
;	7-Jan-81	Conversion to TOPS20 
;
;	16-Sep-80	added optional ADJBP macro for KL to KI conversion.
;
;	16-Sep-80	added ROTRAN routine to randomize starting orientation.
;
;	05-Oct-80	move one-line messages to the bottom of the display.
;
;	12-Oct-80	modify RF command to allow setting energy/torpedoes.
;
;	28-Oct-80	photon fire visually detectable up to 2048 distance.
;
;	28-Oct-80	'harden' starbases by allowing them to refuel.
;
;	04-Nov-80	ship-to-ship messages displayed at bottom of screen.
;
;	04-Nov-80	'more' message shifted to keypad.
;
;	04-Nov-80	added planet rebellions.
 
ifndef tops20,<tops20==0>		;default to TOPS10
ifndef ftki10,<ftki10==0>		;Not KI10

	title	TREK
	sall
	twoseg

	.TEXT	"/SYMSEG:LOW"			;[BUDD] SYMBOL TABLE IN LOWSEG
	.TEXT	"SYS:FORLIB/SEGMENT:LOW/SEARCH"	;[BUDD] MATHLIB STUFF IN LOWSEG
	%VER==:0				;[BUDD] ??? FORLIB WANTS IT

ife tops20,<
	search	UUOSYM
>
 
ifn tops20,<
	search monsym,macsym
	.jbuuo==40
>

;Version definitions

tk.ver=2			;Version 2
tk.min=0			;Minor ver
tk.who=0			;Who last edited
tk.edt=100			;Edit #

; acs

rs=0
 
t1=1			;temporary registers
t2=2
t3=3
t4=4
 
uot=5			;accumulator for universal table index
row=6			;accumulator for row values
col=7			;accumulator for col values
 
lst=10			;accumulator for target list routines
 
p1=11			;registers used by the queue routines.
p2=12			;must be considered permanent by any routine
p3=13			;that isn't a queue routine.
p4=14
 
suot=15			;uot of this ship - set at startup, never changed
 
ap=16			;general purpose register
c=16			;  (ap is sometimes called c)
p=17			;pdl pointer
sp=17			;  (p is sometimes called sp)
 
pdlsz=200		;pdl size
pdl:	block	pdlsz	;push down list
 
ife tops20,<
ttychn=1		;tty channel
hlpchn=2		;help file channel
>
 
sh.ct=10		;number of ships
sb.ct=10		;number of starbases
pl.ct=100		;number of planets and interceptors
st.ct=100		;number of stars
 
sh.mn=0			;low index of ships in universal table
sb.mn=10		;low index of starbases
pl.mn=20		;low index of planets and interceptors
st.mn=120		;low index of stars
 
sh.mx=7			;high index of ships in universal table
sb.mx=17		;high index of starbases
pl.mx=117		;high index of planets
st.mx=217		;high index of stars
 
vtflag:	1
v52flg:	0		;-1 if vt100 in vt52 mode
dbugf:	0
ifn tops20,<
hlpjfn:	z
savmod:	z		;tty JFN mode saved here
d.tcnt:	z		;counter to prevent time from being displayed too ofter
bootf:	-1		; once only flag for BOOTS
gjblk:	gj%old
	.nulio,,.nulio
	-1,,tk.dev
	-1,,tk.dir
	-1,,tk.nam
	0		;file type - to be supplied
	0		;protection
	0		;account
	0		;JFN (not used)

tk.nam:	block	10	;name of program
tk.dir:	block	10	;directory of program
tk.dev:	block	10	;device of program
>
 
ife tops20,<
l.hr:	z		;last hour displayed
l.mn:	z		;last minute displayed
>

d.line:	z
d.last:	z
 
f.data:	z			;data for fortran calls
f.loc:	200,,f.data		;location of fortran data
 
f.max:	z
f.hit:	z
f.uot:	z
 
max.en:	dec	5000000
 
k256:	128.0
k181:	90.50966802
 
i.char:	z
i.sign:	z
i.nbr:	z
i.path:	z
i.pos:	z
i.spos:	z
i.max:	z
 
sin.a:	z
cos.a:	z
tan.a:	z
sin.b:	z
cos.b:	z
tan.b:	z
 
time.f:	0
var.x:	0
var.y:	^d256
 
p.ener:	z
p.time:	z
p.save:	z
p.rang:	z
 
b1:	z
e1:	z
r1:	z
 
x1:	z
y1:	z
z1:	z
x2:	z
y2:	z
z2:	z
 
comp.x:	z
comp.y:	z
comp.z:	z
 
a.absx:	z
a.absy:	z
a.absz:	z
 
ran.mn:	1
ran.mx:	100
ran.nr:	z
ran.sd:	z
 
r.fire:	z		;= 0 rapid fire off
			;< 0 rapid fire on
rf.pha:	^d200		;rapid fire phaser energy
rf.pho:	^d1		;rapid fire photon count
 
a.fire:	z		;phaser/photon work area for bases, interceptors,
			;and unmanned ships:
			;
			;lh - weapons code, bit 9: 0 = pha, 1 = pho.
			;rh - energy to be applied.
 
;	ship masks
;
;	ship masks are used in the event queue to indicate which ship an
;	event applies to, and in the universal table to indicate which
;	libraries an object is in.  the mask is always the leftmost 8 bits
;	in a halfword.  the bits are in reverse order.  bit 18 pertains to
;	ship 8, bit 25 to ship 1.
 
mask.f:	252000		;all federation ships
mask.k:	524000		;all klingon ships
mask.a:	776000		;all ships, federation and klingon
mask.c:	0		;this ship only (set during setup)
mask.o:	776000		;any ship but this one (set during setup)
mask.u:	524000		;'us' - friendly ships (set during setup)
mask.t:	524000		;'them' - enemy ships (set during setup)
 
mska.u:	z		;'us' for unmanned ships.
mska.t:	z		;'them' for unmanned ships.
 
;	ally masks
;
;	used to determine which side an object is on.  masks bits
;	29 thru 31 in the u.tab word.
 
ally.f:	1b31		;federation mask.
ally.k:	1b30		;klingon mask.
ally.n:	1b29		;neutral mask.
ally.a:	7b31		;neutral, federation, or klingon.
ally.u:	1b30		;'us' - our side (set by setup routine).
ally.t:	1b30		;'them' - their side (set by setup routines).
 
alya.u:	z		;'us' for unmanned ships.
alya.t:	z		;'them' for unmanned ships.
 
chan.c:	z
chan.f:	z
chan.k:	z
chan.a:	z
 
u.side:: z			;side a player is on (used during startup)
 
eadd.t:	z		;event queue add area
eadd.a:	z
eadd.b:	z
eadd.x:	z
eadd.y:	z
eadd.z:	z
 
ewrk.t:	z		;event queue work area
ewrk.a:	z
ewrk.b:	z
ewrk.x:	z
ewrk.y:	z
ewrk.z:	z
 
m.time:	z
 
work.q:	block	600
 
	reloc	400K
ifn tops20,<
SHRBEG:: 
segver:	byte (3)tk.who (9)tk.ver (6)tk.min (18)tk.edt
				;matched against EV+2 at startup
>
;	high-segment information shared by all ships
 
gam.nr:	z		;tournament game nbr or 0 if random
 
gam.tm:	^d120		;minutes remaining in the game
gam.hr:	z		;current hour
gam.mn:	z		;current minute
 
i.lock:	z		;initial (startup) lock.  keeps 2 or more players
			;from starting up simultaneously.
 
i.time:	z		;time i.lock was set.  allows i.lock to be reset if
			;system crash occurred while a player was starting up.
 
q.time:: 1		;= 0,	no non-ship (base, planet, interceptor)
			;	is waiting to be activated.
			;> 0,	lowest time that a non-ship is due to be
			;	activated.
 
mask.q:: z		;8-bit mask (0-7) indicating active ships.
 
time.q:: block	120	;mstime that an unmanned ship or a non-ship is to
			;be activated.  zero means the entry is empty.
 
rebel:	block	120	;mstime after which a planet may consider rebellion.
 
;	event queue
 
q.size=600*6		;size of the event queue
 
hq.min=0
hq.max=77*6
 
lq.min=100*6
lq.max=577*6
 
q::	block	q.size
 
evnt.t==q		;mstime after which event is to occur.
			;= 0,	entry is empty.
			;< 0,	entry is being temporarily held by a ship.
 
evnt.a==q+1		;event code word:
			;0-7	ships to whom event applies (8-bit mask, ships
			;	7 to 0).  when a ship processes the event,
			;	it sets its bit to 0.  when the mask is all 0,
			;	all ships have processed the event and the
			;	entry is returned to the available pool.
			;8-9	weapons code:
			;	  0 = phasers
			;	  1 = photon torpedo
			;	message code:
			;	  0 = ship detected
			;	  1 = ship attacked
			;10-17	uot of ship that sourced the event.  this is
			;	the 'secondary' uot.
			;18	message bit indicating an 'under attack' msg
			;	should be displayed.
			;19-29	not used.
			;30-35	event code.
 
evnt.b==q+2		;uot word:
			;0-17	energy (for weapons and energy transfer).
			;18-27	not used.
			;28-35	uot of ship to whom the event is to occur.
			;	(may also be the sourcing uot, depending on
			;	the event.)  this is the 'primary' uot.
 
evnt.x==q+3		;absolute coordinates of object to whom event is to
evnt.y==q+4		;occur.  used to test whether object has moved since
evnt.z==q+5		;event was initiated (mainly for weapons).
 
	z
 
;	universal object tables
;
;	data describing all of the objects in the galaxy.  u.tab is a
;	general information word filled in when the galaxy is loaded.
;	initially, u.tab contains only uid's (id identifying what the
;	object is).  the term 'uot' usually means the index into these
;	tables.
 
u.tab::	repeat	4,<exp 5,6>		;federation, klingon ships
	repeat	4,<exp 3,4>		;federation, klingon bases
	repeat	20,<exp 2,7,7,7>	;planets and their interceptors
	repeat	100,<exp 1>		;stars
	z
 
u.absx:	block	220		;absolute x,y,z coordinates of
u.absy:	block	220		;the object (floating point)
u.absz:	block	220
 
u.ener:	block	220		;ship and shield energy.  all objects have an
u.shld:	block	220		;energy allocation. (binary milliunits)
 
u.msg:	block	130		;message area, one line per ship
 
u.alrt:	block	10		;alert status (ships only).
 
u.job:	block	10		;job nr of player
ife tops20,<
u.ppn:	block	10		;ppn of player
u.nam1:	block	10		;12-char name of player
u.nam2:	block	10
>
ifn tops20,<
u.namx:	block	10		;user number of player
>
 
u.time:	block	10		;mstime player was last active.  when game
				;is run, any player with no activity for
				;past 5 minutes is reset.  this is intended
				;as a means to reset the game after a system
				;crash.  the time is updated every second
				;or so whether the player enters a command
				;or not, so it's not a time limit within
				;which a player has to make a move.
 
u.begx:	block	10		;ship positions assigned at startup.  players
u.begy:	block	10		;coming back into the game begin at their
u.begz:	block	10		;original starting position.
 
u.lstx:	block	10		;last known position of a ship.
u.lsty:	block	10
u.lstz:	block	10
 
u.tty:	block	10		;tty of player.  tty nbr determines
				;whether a player was previously in the
				;game, hence is in the shared section.
 
u.wait:	block	10		;mstime at which a player may reenter the
				;game.  player must wait 2 minutes before
				;reentry is allowed.
 
u.torp:	block	10		;number of torpedoes a ship has.
 
n.muot:	block	10		;object toward which an unmanned ship is
				;moving.
 
n.mssn:	block	10		;unmanned ship's current mission.
 
;	wf.dis and wf.ene - distances and energy used when moving at
;	standard warp factors.
 
wf.dis:	dec	1		;warp 0
	dec	2		;warp 1
	dec	4		;warp 2
	dec	8		;warp 3
	dec	16		;warp 4
	dec	32		;warp 5
	dec	64		;warp 6
	dec	128		;warp 7
	dec	256		;warp 8
	dec	512		;warp 9
 
wf.ene:	dec	1		;warp 0
	dec	4		;warp 1
	dec	16		;warp 2
	dec	64		;warp 3
	dec	256		;warp 4
	dec	1024		;warp 5
	dec	4096		;warp 6
	dec	16384		;warp 7
	dec	65536		;warp 8
	dec	262144		;warp 9
 
;	universal table initial values, loaded at startup
;
;	u.tab bit assignments and values:
;18	0	0 (positive), object is active.
;		1 (negative), object is inactive or destroyed.
;19	1	0 - ship is not occupied (not under human control).
;		1 - ship is under automatic control.
;	2-7	not used.
;26	8	enemy detected.
;		0 - notify others.
;		1 - others have been notified.
;27	9	enemy under attack.
;		0 - notify others.
;		1 - others have been notified.
;	10-17	planets:
;		10	not used.
;29		11	defenses up (1) or down (0).
;30-32		12-14	launched interceptor bits.
;33-35		15-17	interceptor in base bits.
;		interceptors:
;28-31		10-13	count-down field, fire if zero.
;32-35		14-17	index to a.fact and b.fact, offset values for motion.
;	18-25	library mask, 1 bit per ship.  if mask bit is set, object
;		is in that ships library.
;	26-28	not used.
;	29-31	alliance:
;		29	neutral.
;		30	klingon.
;		31	federation.
;	32-35	object id (uid).
;		0 - not used.
;		1 - star.
;		2 - planet.
;		3 - federation base.
;		4 - klingon base.
;		5 - federation ship.
;		6 - klingon ship.
;		7 - interceptor.
 
ui.t0:	byte	(1)0(17)0(8)0(3)0(3)0(4)0	;romulan
ui.t1:	byte	(1)0(17)0(8)0(3)0(3)4(4)1	;star
ui.t2:	byte	(1)0(17)107(8)0(3)0(3)4(4)2	;planet
ui.t3:	byte	(1)0(17)0(8)125(3)0(3)1(4)3	;fed base
ui.t4:	byte	(1)0(17)0(8)252(3)0(3)2(4)4	;kli base
ui.t5:	byte	(1)0(17)0(8)125(3)0(3)1(4)5	;fed ship
ui.t6:	byte	(1)0(17)0(8)252(3)0(3)2(4)6	;kli ship
ui.t7:	byte	(1)1(17)0(8)0(3)0(3)4(4)7	;interceptor
 
ui.e0:	dec	3000000	;ship energy starting values
ui.e1:	dec	200000000
ui.e2:	dec	20000000
ui.e3:	dec	5000000
ui.e4:	dec	5000000
ui.e5:	dec	3000000
ui.e6:	dec	3000000
ui.e7:	dec	0
 
ui.s0:	dec	2000000	;shield energy starting values
ui.s1:	dec	200000000
ui.s2:	dec	20000000
ui.s3:	dec	5000000
ui.s4:	dec	5000000
ui.s5:	dec	2000000
ui.s6:	dec	2000000
ui.s7:	dec	499000
 
shrend:	reloc			;end of shareable data base
 
;	ship object tables
;
;	object information from the perspective of the ship
 
o.relx:	block	220		;object x,y,z coordinates relative to
o.rely:	block	220		;the ship (floating point)
o.relz:	block	220
 
o.elev:	block	220		;object elevation, bearing, and range
o.bear:	block	220		;(b,e are tangents; r is floating point)
o.rang:	block	220
 
s.uot:	z			;uot of the ship (same as suot accumulator)
s.mask:	z			;a work mask
s.muid:	z			;a work universal id
s.warp:	dec	7		;current warp factor
 
s.11:	1.0			;3x3 matrix for vector calculations
s.12:	0.0
s.13:	0.0
s.21:	0.0
s.22:	1.0
s.23:	0.0
s.31:	0.0
s.32:	0.0
s.33:	1.0
 
a.11:	1.0			;3x3 work matrix
a.12:	0.0
a.13:	0.0
a.21:	0.0
a.22:	1.0
a.23:	0.0
a.31:	0.0
a.32:	0.0
a.33:	1.0
 
;	wf.tab - this ship's warp factor distances (changeable by player).
 
wf.tab:	dec	1,2,4,8,16,32,64,128,256,512
 
;	table of ranges used by unmanned ships.
 
n.rang:	block	120
 
;	a list of nearest objects of a class and their ranges, used by
;	unmanned ships.
 
n.nuot:	block	10
nupl.n=n.nuot		;nearest neutral planet.
nupl.u=n.nuot+1		;nearest friendly planet.
nupl.t=n.nuot+2		;nearest enemy planet.
nusb.u=n.nuot+3		;nearest friendly base.
nusb.t=n.nuot+4		;nearest enemy base.
nush.u=n.nuot+5		;nearest friendly ship.
nush.t=n.nuot+6		;nearest enemy ship.
nuin.a=n.nuot+7		;nearest interceptor, any side.
 
n.nran:	block	10
nrpl.n=n.nran		;nearest neutral planet.
nrpl.u=n.nran+1		;nearest friendly planet.
nrpl.t=n.nran+2		;nearest enemy planet.
nrsb.u=n.nran+3		;nearest friendly base.
nrsb.t=n.nran+4		;nearest enemy base.
nrsh.u=n.nran+5		;nearest friendly ship.
nrsh.t=n.nran+6		;nearest enemy ship.
nrin.a=n.nran+7		;nearest interceptor, any side.
 
n.ener:	z		;total shield plus ship energy of unmanned ship.
 
n.pcnt:	z		;count of captured planets, used by unmanned ships.
n.scnt:	z		;count of near enemy ships, used by unmanned ships.
 
;	quadrant table used at startup.  xyz.i is the index.  xyz.t entries
;	have a bit for x,y,z.  if set, bit means coordinate is to be
;	negated.  determines where objects will go at startup, ensures that
;	objects will be evenly distributed in 8 quadrants of galaxy.
 
xyz.i:	7
xyz.t:	dec	0,1,3,2,5,4,6,7
 
;	target list
 
l.idx:	z
luot.a:	exp	-1,-1,-1,-1,-1
luot.b:	exp	-1,-1,-1,-1,-1
 
m.msg:	block	^d11
m.ptr:	point	7,m.msg
m.wptr:	z
m.row:	z
 
t.row:	^d7		;target row and col, not necessarily within range of
t.col:	^d41		;the viewer or the screen.
t.view:	1
t.elem:	z
t.uot:	-1		;if not < 0, indicates target is locked on object t.uot
t.bear:	z		;to confuse things, target b,e is kept in degrees, not
t.elev:	z		;as tangents (floating point)
 
t.rmax:	z		;some min and max values used when determining whether
t.rmin:	z		;an object is pointed to by the target.
t.cmax:	z
t.cmin:	z

a.fact:	128.0			;each of a planet's 3 interceptors rotates
	118.2565802		;around the planet at a fixed distance of
	90.50966802		;128 units.  rotation is in one of the planet's
	48.98347936		;3 primary planes.  a.fact and b.fact are
	0.0			;used to compute the interceptor's next
	-48.98347936		;position, in absolute coordinates, relative
	-90.50966802		;to the absolute coordinates of the planet.
	-118.2565802
	-128.0			;it keeps the program from having to do a lot
	-118.2565802		;of accumulator-destroying trig.
	-90.50966802
	-48.98347936		;a.fact = 128 * cos ang
	0.0			;b.fact = 128 * sin ang
	48.98347936		;
	90.50966802		;where ang varies from 0 to 360 in
	118.2565802		;22.5 degree increments
 
b.fact:	0.0
	48.98347936
	90.50966802
	118.2565802
	128.0
	118.2565802
	90.50966802
	48.98347936
	0.0
	-48.98347936
	-90.50966802
	-118.2565802
	-128.0
	-118.2565802
	-90.50966802
	-48.98347936
 
c.inte:	z			;integer returned by VTGET
c.char:	z			;character returned by VTGET
 
c.cmd:	z			;command nbr returned by VTCMD
c.dir:	z			;direction returned by VTCMD
c.nbr1:	z			;1st number returned by VTCMD
c.nbr2:	z			;2nd number returned by VTCMD
c.cnt:	z			;nr of numbers entered
c.imm:	z			;immediate execute flag
 
c.tab:	xwd	0,"  "		;command abbreviations
	xwd	0,"SP"		;1   special
	xwd	0,"LO"		;2   lock target
	xwd	0,"RE"		;3   refuel and reload
	xwd	0,"SH"		;4   shields
	xwd	0,"TA"		;5   target
	xwd	0,"PH"		;6   phaser
	xwd	0,"TO"		;7   photon torpedo
	xwd	8,"MO"		;8   move
	xwd	0,"RO"		;9   rotate
	xwd	0,"WR"		;10  warp
	xwd	0,"LI"		;11  display target list
	xwd	0,"CA"		;12  capture planet
	xwd	0,"TR"		;13  transfer energy
	xwd	0,"BA"		;14  display all bases
	xwd	0,"BN"		;15  display nearest base
	xwd	0,"AL"		;16  list all objects
	xwd	0,"FE"		;17  list federation objects
	xwd	0,"KL"		;18  list klingon objects
	xwd	0,"PL"		;19  list planetary objects
	xwd	0,"SE"		;20  send a message
	xwd	0,"NE"		;21  get the news (a HELP feature)
	xwd	0,"US"		;22  list users
	xwd	0,"HE"		;23  help
	xwd	0,"H "		;24  help synonym
	xwd	0,"X "		;25  exit program
	xwd	0,"Q "		;26  quit (exit synonym)
	xwd	0,"R "		;27  refresh screen
	xwd	0,"RT"		;28  refresh with VT100 self-test
	xwd	0,"RF"		;29  rapid fire mode on/off
	xwd	0,"ST"		;30  display active status
	xwd	0,"AS"		;31  request assistance
	xwd	0,"RA"		;32  red alert
	xwd	0,"YA"		;33  yellow alert
	xwd	0,"SA"		;34  secure from alert
	xwd	0,"FB"		;35  list fed bases
	xwd	0,"FP"		;36  list fed planets
	xwd	0,"FS"		;37  list fed ships
	xwd	0,"KB"		;38  list kli bases
	xwd	0,"KP"		;39  list kli planets
	xwd	0,"KS"		;40  list kli ships
	xwd	0,"NP"		;41  list neutral planets
	xwd	0,"PN"		;42  list neutral planets (synonym)
;	xwd	0,"S "		;43  display/suppress stars
 
c.size=.-c.tab			;size of command abbr table
 
d.tab:	asciz	"    "
	asciz	"  UP"
	asciz	"  DN"
	asciz	"  RI"
	asciz	"  LF"
	asciz	" FED"
	asciz	" KLI"
	asciz	" ALL"
	asciz	" ALL"
	asciz	"  FW"
	asciz	"  BK"
	asciz	"  RI"
	asciz	"  LF"
 
w.row:	z
w.col:	z
w.id:	z
w.uot:	z
w.bear:	z
w.elev:	z
w.rang:	z
 
;	scanner tables
;
;	scan.1 and scan.2 contain data on objects that are visible in the
;	viewer.
;
;	scan.1:
;		bit 0-8		object nbr (index to universal tables)
;		bit 9-17	object id (1 thru 7)
;		bit 18-26	viewer column
;		bit 27-35	viewer row
;	scan.2:
;		range (converted to integer)
;
;	the scan tables are in ascending sequence by row, descending
;	sequence by range within row.
 
scan.1:	block	^d145
scan.2:	block	^d145
s.max:	z
s.star:	z
 
v.pos:	z
v.col:	z
v.row:	z
v.flag:	z
v.rset:	z
 
v.mod:	z
v.gra:	asciz	"(0"
v.asc:	asciz	"(B"
 
;	viewer tables
;
;	viewer area 'bit maps'.
;
;	v.wrk:		work area for one viewer row
;	v.tab:		complete viewer area (all rows)
;
;	viewer tables are in '6-bit';  the low 5 bits correspond to an
;	entry in the viewer element table;  the high bit indicates the
;	location is the target if 1, not the target if 0
 
v.wrk:	block	^d14
v.tab:	block	^d173
 
v.wrkp:	point	6,v.wrk
v.tabp:	point	6,v.tab
 
v.wptr:	point	6,v.wrk
v.tptr:	point	6,v.tab
 
;	viewer object table
;
;	list of displayable objects at 8 ranges
;
;	1st 6 bytes are element nrs (from v.elem); 00 implies end of elements.
;	7th byte is offset from center of object;   7 implies no display.
 
v.obj:	byte	(5)17,22,12,22,17,00(6)2	;range 0 - rom ship
	byte	(5)05,00,00,00,00,00(6)0	;          star
	byte	(5)13,15,14,00,00,00(6)1	;          planet
	byte	(5)20,12,20,12,20,00(6)2	;          fed base
	byte	(5)11,12,11,12,11,00(6)2	;          kli base
	byte	(5)16,21,27,21,16,00(6)2	;          fed ship
	byte	(5)17,22,10,22,17,00(6)2	;          kli ship
	byte	(5)24,17,25,00,00,00(6)1	;          interceptor
	byte	(5)23,12,23,00,00,00(6)1	;range 1 - rom ship
	byte	(5)05,00,00,00,00,00(6)0	;          star
	byte	(5)13,15,14,00,00,00(6)1	;          planet
	byte	(5)20,12,20,12,20,00(6)2	;          fed base
	byte	(5)11,12,11,12,11,00(6)2	;          kli base
	byte	(5)22,26,22,00,00,00(6)1	;          fed ship
	byte	(5)23,17,23,00,00,00(6)1	;          kli ship
	byte	(5)30,00,00,00,00,00(6)0	;          interceptor
	byte	(5)04,00,00,00,00,00(6)0	;range 2 - rom ship
	byte	(5)05,00,00,00,00,00(6)0	;          star
	byte	(5)13,15,14,00,00,00(6)1	;          planet
	byte	(5)17,17,17,00,00,00(6)1	;          fed base
	byte	(5)12,12,12,00,00,00(6)1	;          kli base
	byte	(5)04,00,00,00,00,00(6)0	;          fed ship
	byte	(5)04,00,00,00,00,00(6)0	;          kli ship
	byte	(5)04,00,00,00,00,00(6)0	;          interceptor
	byte	(5)01,00,00,00,00,00(6)0	;range 3 - rom ship
	byte	(5)05,00,00,00,00,00(6)0	;          star
	byte	(5)17,00,00,00,00,00(6)0	;          planet
	byte	(5)04,00,00,00,00,00(6)0	;          fed base
	byte	(5)04,00,00,00,00,00(6)0	;          kli base
	byte	(5)01,00,00,00,00,00(6)0	;          fed ship
	byte	(5)01,00,00,00,00,00(6)0	;          kli ship
	byte	(5)02,00,00,00,00,00(6)0	;          interceptor
	byte	(5)02,00,00,00,00,00(6)0	;range 4 - rom ship
	byte	(5)06,00,00,00,00,00(6)0	;          star
	byte	(5)03,00,00,00,00,00(6)0	;          planet
	byte	(5)01,00,00,00,00,00(6)0	;          fed base
	byte	(5)01,00,00,00,00,00(6)0	;          kli base
	byte	(5)02,00,00,00,00,00(6)0	;          fed ship
	byte	(5)02,00,00,00,00,00(6)0	;          kli ship
	byte	(5)00,00,00,00,00,00(6)7	;          interceptor
	byte	(5)00,00,00,00,00,00(6)7	;range 5 - rom ship
	byte	(5)03,00,00,00,00,00(6)0	;          star
	byte	(5)01,00,00,00,00,00(6)0	;          planet
	byte	(5)02,00,00,00,00,00(6)0	;          fed base
	byte	(5)02,00,00,00,00,00(6)0	;          kli base
	byte	(5)00,00,00,00,00,00(6)7	;          fed ship
	byte	(5)00,00,00,00,00,00(6)7	;          kli ship
	byte	(5)00,00,00,00,00,00(6)7	;          interceptor
	byte	(5)00,00,00,00,00,00(6)7	;range 6 - rom ship
	byte	(5)01,00,00,00,00,00(6)0	;          star
	byte	(5)02,00,00,00,00,00(6)0	;          planet
	byte	(5)00,00,00,00,00,00(6)7	;          fed base
	byte	(5)00,00,00,00,00,00(6)7	;          kli base
	byte	(5)00,00,00,00,00,00(6)7	;          fed ship
	byte	(5)00,00,00,00,00,00(6)7	;          kli ship
	byte	(5)00,00,00,00,00,00(6)7	;          interceptor
	byte	(5)00,00,00,00,00,00(6)7	;range 7 - rom ship
	byte	(5)02,00,00,00,00,00(6)0	;          star
	byte	(5)00,00,00,00,00,00(6)7	;          planet
	byte	(5)00,00,00,00,00,00(6)7	;          fed base
	byte	(5)00,00,00,00,00,00(6)7	;          kli base
	byte	(5)00,00,00,00,00,00(6)7	;          fed ship
	byte	(5)00,00,00,00,00,00(6)7	;          kli ship
	byte	(5)00,00,00,00,00,00(6)7	;          interceptor
 
v.elem:	xwd	0,"0 "		;viewer element table
	xwd	1,"1~"		;
	xwd	1,"0~"		;a list of all characters that can be displayed
	xwd	0,"0."		;in the viewer area
	xwd	0,"0-"		;
	xwd	0,"1*"		;left half:
	xwd	0,"0*"		;  0 - can be displayed in any mode
	xwd	1,"0`"		;  1 - requires graphics mode
	xwd	0,"00"		;  2 - requires ascii mode
	xwd	0,"08"		;
	xwd	0,"0="		;right half - 1st character:
	xwd	0,"0("		;  0 - normal intensity
	xwd	0,"0)"		;  1 - bold (increased) intensity
	xwd	0,"0@"		;
	xwd	1,"0f"		;right half - 2nd character:
	xwd	2,"0o"		;  character to be displayed
	xwd	0,"0O"
	xwd	1,"0p"
	xwd	1,"0q"
	xwd	1,"0r"
	xwd	1,"0t"
	xwd	1,"0u"
	xwd	2,"0v"
	xwd	0,"0V"
	xwd	0,"0H"
 
;	list of specific object names
 
o.name:	exp	nm00,nm01,nm02,nm03,nm04,nm05,nm06,nm07
	exp	nm10,nm11,nm12,nm13,nm14,nm15,nm16,nm17
	exp	nm20,0,0,0,nm21,0,0,0,nm22,0,0,0,nm23,0,0,0
	exp	nm24,0,0,0,nm25,0,0,0,nm26,0,0,0,nm27,0,0,0
	exp	nm30,0,0,0,nm31,0,0,0,nm32,0,0,0,nm33,0,0,0
	exp	nm34,0,0,0,nm35,0,0,0,nm36,0,0,0,nm37
 
nm00:	asciz	"ENTERPRISE"
nm01:	asciz	"COBRA"
nm02:	asciz	"INTREPID"
nm03:	asciz	"HAWK"
nm04:	asciz	"LEXINGTON"
nm05:	asciz	"PYTHON"
nm06:	asciz	"VALIANT"
nm07:	asciz	"RAVEN"
nm10:	asciz	"17"
nm11:	asciz	"21"
nm12:	asciz	"18"
nm13:	asciz	"22"
nm14:	asciz	"19"
nm15:	asciz	"23"
nm16:	asciz	"20"
nm17:	asciz	"24"
nm20:	asciz	"ALPHA 1"
nm21:	asciz	"BETA 2"
nm22:	asciz	"GAMMA 3"
nm23:	asciz	"DELTA 4"
nm24:	asciz	"EPSILON 5"
nm25:	asciz	"ZETA 6"
nm26:	asciz	"RIGEL 7"
nm27:	asciz	"THETA 8"
nm30:	asciz	"IOTA 9"
nm31:	asciz	"KAPPA 10"
nm32:	asciz	"LAMBDA 11"
nm33:	asciz	"OMICRON 12"
nm34:	asciz	"SIGMA 13"
nm35:	asciz	"TAU 14"
nm36:	asciz	"UPSILON 15"
nm37:	asciz	"OMEGA 16"
 
o.nbr:	exp	20,24,30,34,40,44,50,54
	exp	60,64,70,74,100,104,110,114
	exp	10,12,14,16,11,13,15,17
 
o.init:	asciz	"E"
	asciz	"C"
	asciz	"I"
	asciz	"H"
	asciz	"L"
	asciz	"P"
	asciz	"V"
	asciz	"R"
 
;	list of generic (universal) object names
 
u.name:	asciz	"             "
	asciz	"Star         "
	asciz	"Neu Planet   "
	asciz	"Fed Starbase "
	asciz	"Kli Starbase "
	asciz	"Fed Starship "
	asciz	"Kli Cruiser  "
	asciz	"Interceptor  "
 
p.name:	ascii	"Neu P"
	ascii	"Fed P"
	ascii	"Kli P"
 
su.ln1:	asciz	"  FederationKlingon Empire"
su.ln2:	asciz	"  ------------------------"
 
spc.55:	asciz	"                                                       "
spc.31:	asciz	"                               "
 
n.wrk:	block	3
 
wtime:	z
t.time:	z
t.more:	z
t.mor1:	z
t.mor2:	z
t.mor3:	z
t.mor4:	z
 
row.1:	z
row.2:	z
 
;	PSI interrupt blocks
 
ife tops20,<
ivb:	exp	ictrap,0,ps.vds,0
 
ccarg:	exp	.pcstp
	xwd	0,0
	0
> 
ifn tops20,<
levtab:	lev1pc
	lev2pc
	lev3pc


lev1pc:	z
lev2pc:	z
lev3pc:	z

chntab:	0			;(0)
	1,,ictrap		;(1) ctrl-c
	2,,itypin		;(2) typein
   repeat ^d33,<0>		;Unused channels
>
flsh.p:	z
flsh.t:	block	60
 
flsh01:	z
flsh03:	byte	(2)0(16)2(18)3
	z
flsh05:	byte	(2)1(16)1(18)1
	byte	(2)2(16)2(18)1
	byte	(2)2(16)0(18)1
	byte	(2)1(16)1(18)2
	z
flsh11:	byte	(2)1(16)2(18)2
	byte	(2)2(16)3(18)2
	byte	(2)2(16)1(18)3
	byte	(2)1(16)1(18)2
	byte	(2)1(16)2(18)1
	z
flsh16:	byte	(2)1(16)3(18)3
	byte	(2)2(16)4(18)3
	byte	(2)2(16)2(18)5
	byte	(2)1(16)2(18)3
	byte	(2)1(16)3(18)2
	z
flsh24:	byte	(2)1(16)2(18)2
	byte	(2)1(16)4(18)3
	byte	(2)2(16)4(18)3
	byte	(2)2(16)4(18)5
	byte	(2)2(16)4(18)6
	byte	(2)2(16)5(18)7
	byte	(2)1(16)2(18)3
	byte	(2)1(16)4(18)5
	byte	(2)1(16)5(18)4
	byte	(2)1(16)5(18)4
	z
 
ife tops20,<
in.cnt:	z
in.ptr:	z
 
in.lst:	iowd	200,in.blk
	0
 
in.blk:	block	200
 
op.blk:	xwd	0,.iodmp+io.syn
op.dev:	sixbit	/DSK/
	xwd	0,io.blk
 
lk.blk:
lk.nam:	sixbit	/VTTREK/
lk.ext:	sixbit	/HLP/
	0
lk.ppn:	xwd	0,0
>
 
io.ptr:	z
io.cnt:	z
io.blk:	block	13
	z
 
;tty characteristics
ife tops20,< 
tolct:	z
tofrm:	z
tonfc:	z
towid:	z
topag:	z
>

opdef	call	[pushj	p,]
opdef	ret	[popj	p,]
opdef	pjrst	[jrst]		;replaces pushj/popj sequences
opdef	retskp	[jrst	rskp]
 
;*****	TYPE	types an ascii string without a CRLF.
;	TYPEC	types an ascii string followed by a CRLF.
;	CRLF	types a CRLF.
 
define	type	(string)<
	outstr	[asciz $'string'$]
>
define	typec	(string)<
	outstr	[asciz $'string'
$]>
define	crlf	<
	outstr	[asciz $
$]>
 
;*****	DSPTYP	types an ascii string in the display area.
;	MSPTYP	types an ascii string on the message line.
 
define	dsptyp	(string)<
	dspstr	[asciz $'string'$]
>
define	msptyp	(string)<
	mspstr	[asciz $'string'$]
>
 
;*****	MORDSP	causes the MOR key to flash.
;	MORCLR	returns the MOR key to its normal state.
 
define	mordsp	<
	outstr	[asciz /MOR8/]
>
define	morclr	<
	outstr	[asciz /MOR8/]
>
 
;*****	GETIME	gets the mstime and compares it to the last mstime retrieved.
;		if not greater, assume new day and subtract 24 hours.
 
ife tops20,<
define	getime	(ac)<
	mstime	ac,
	camge	ac,u.time(suot)
	add	ac,[^d86400000]
	movem	ac,u.time(suot)
>>
ifn tops20,<
define	getime	(ac)<
   ifn ac-t1,<exch ac,t1>
	save	t2
	time
	movem	t1,u.time(suot)
	rest	t2
   ifn ac-t1,<exch t1,ac>
>>

;*****	SAVE	saves up to 10 registers.
;	REST	restores registers saved by SAVE.
 
define	save	(d0,d1,d2,d3,d4,d5,d6,d7,d8,d9)<
	ifn	d0,<push p,d0>
	ifn	d1,<push p,d1>
	ifn	d2,<push p,d2>
	ifn	d3,<push p,d3>
	ifn	d4,<push p,d4>
	ifn	d5,<push p,d5>
	ifn	d6,<push p,d6>
	ifn	d7,<push p,d7>
	ifn	d8,<push p,d8>
	ifn	d9,<push p,d9>
>
define	rest	(d0,d1,d2,d3,d4,d5,d6,d7,d8,d9)<
	ifn	d9,<pop  p,d9>
	ifn	d8,<pop  p,d8>
	ifn	d7,<pop  p,d7>
	ifn	d6,<pop  p,d6>
	ifn	d5,<pop  p,d5>
	ifn	d4,<pop  p,d4>
	ifn	d3,<pop  p,d3>
	ifn	d2,<pop  p,d2>
	ifn	d1,<pop  p,d1>
	ifn	d0,<pop  p,d0>
>
 
;	TREK is a KL10 program.  The following macro handles the ADJBP if
;	the program is run on a KI.  KL versions have REPEAT 0 preceding
;	the macro, KI versions have REPEAT 1.
 
ifn ftki10,<
define	adjbp	(r,p)<
	move	rs,r
	move	r,p
	ibp	r
	sojg	rs,.-1
>>
ife tops20,<
define	gexit <
	exit	1,
	exit
>>
ifn tops20,<
define	gexit <
	haltf
	jrst	trek
>>

;	Displays in the 4-line display area and on the message line are
;	performed using local UUOs.  The DSP UUOs display in the display
;	area.  The MSP UUOs display on the message line.

	loc	41
	call	uuoser
ife tops20,<
	loc	137
	byte (3)tk.who (9)tk.ver (6)tk.min (18)tk.edt
>
	reloc
 
opdef	dspini	[1b8]
opdef	dspchr	[2b8]
opdef	dspstr	[3b8]
opdef	dsppos	[4b8]
opdef	dspout	[5b8]
opdef	dspclr	[6b8]
opdef	dspimm	[7b8]
opdef	mspini	[10b8]
opdef	mspchr	[11b8]
opdef	mspstr	[12b8]
opdef	msppos	[13b8]
opdef	mspout	[14b8]
opdef	mspclr	[15b8]
opdef	mspimm	[16b8]
ifn tops20,<
opdef	inchrw	[35b8]
opdef	outchr	[36b8]
opdef	outstr	[37b8]
>

uuoser:	save	ap
	ldb	ap,[point 9,.jbuuo,8]
	jumpe	ap,uuoerr
	call	@uuotab-1(ap)
	rest	ap
	ret

uuoerr:
ife tops20,<
	outstr	[asciz	/
? Illegal LUUO
/]
	exit	1,
	jrst	.-1
>
ifn tops20,<
	exch	ap,t1
	hrroi	t1,[asciz /
? Illegal LUUO
/]
	psout
	exch	t1,ap
	haltf
	jrst	.-1
> 

uuotab:	%dsini
	%dschr
	%dsstr
	%dspos
	%dsout
	%dsclr
	%dsimm
	%msini
	%mschr
	%msstr
	%mspos
	%msout
	%msclr
	%msimm
	repeat	<37-<.-uuotab>>,<uuoerr>
ifn tops20,<
	reloc	uuotab+34
	.sichw
	.sochr
	.sostr
>

%dsini:	push	p,t1
	hrrz	ap,.jbuuo
	move	t1,[ascii /     /]
	skipn	ap
	  jrst	[movem	t1,utxt.b
		 move	t1,[xwd utxt.b,utxt.b+1]
		 blt	t1,utxt.b+53
		 jrst	%dsi.1]
	sose	ap
	  imuli	ap,13
	movem	t1,utxt.b(ap)
	hrri	t1,utxt.b+1(ap)
	hrli	t1,utxt.b(ap)
	blt	t1,utxt.b+12(ap)
%dsi.1:	move	t1,[point 7,utxt.b]
	add	t1,ap
	movem	t1,.dpptr
	movem	t1,.dwptr
	pop	p,t1
	ret
 
%dschr:	hrrz	ap,.jbuuo
	move	ap,(ap)
	idpb	ap,.dwptr
	ret
 
%dsimm:	hrrz	ap,.jbuuo
	move	ap,(ap)
	outchr	ap
	idpb	ap,.dwptr
	push	p,t1
	move	t1,.dwptr
	subi	t1,54
	dpb	ap,t1
	pop	p,t1
	ret
 
%dsstr:	push	p,t1
	hrrz	ap,.jbuuo
	move	t1,[point 7,0]
	add	t1,ap
%dss.1:	ildb	ap,t1
	jumpe	ap,%dss.2
	idpb	ap,.dwptr
	jrst	%dss.1
%dss.2:	pop	p,t1
	ret
 
%dspos:	hrrz	ap,.jbuuo
	soj	ap,
	adjbp	ap,.dpptr
	movem	ap,.dwptr
	ret
 
%dsout:	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4
	push	p,row
	push	p,col
	hrrz	ap,.jbuuo
	skipn	ap
	  jrst	[movei	ap,1
		 call	%dso.1
		 movei	ap,2
		 call	%dso.1
		 movei	ap,3
		 call	%dso.1
		 movei	ap,4
		 call	%dso.1
		 jrst	.+2]
	call	%dso.1
	pop	p,col
	pop	p,row
	pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1
	ret
 
%dso.1:	move	row,ap
	addi	row,^d17
	sose	ap
	  imuli	ap,13
	move	t1,[point 7,utxt.a]
	add	t1,ap
	movem	t1,.dptra
	move	t1,[point 7,utxt.b]
	add	t1,ap
	movem	t1,.dptrb
	movei	col,6
	setzm	.dcol
%dso.2:	ildb	t1,.dptra
	ildb	t2,.dptrb
	came	t1,t2
	  call	%dso.3
	caige	col,^d59
	aoja	col,%dso.2
	skipe	.dcol
	outstr	[asciz/8/]
	ret
 
%dso.3:	skipg	.dcol
	  jrst	%dso.4
	camg	col,.dcol
	  jrst	%dso.4
	move	t3,col
	sub	t3,.dcol
	soje	t3,%dso.5
	outstr	[asciz/[/]
	caie	t3,1
	  call	%dso.6
	outstr	[asciz/C/]
	jrst	%dso.5
%dso.4:	outstr	[asciz/[/]
	move	t3,row
	call	%dso.6
	outstr	[asciz/;/]
	move	t3,col
	call	%dso.6
	outstr	[asciz/H/]
%dso.5:	outchr	t2
	dpb	t2,.dptra
	movem	col,.dcol
	ret
 
%dso.6:	idivi	t3,^d10
	tro	t3,"0"
	tro	t4,"0"
	caie	t3,"0"
	outchr	t3
	outchr	t4
	ret
 
%dsclr:	move	ap,[ascii /     /]
	movem	ap,utxt.a
	move	ap,[xwd utxt.a,utxt.a+1]
	blt	ap,utxt.a+127
	ret
 
.dpptr:	z	;permanent pointer
.dwptr:	z	;working pointer
.dptra:	z
.dptrb:	z
.dcol:	z
 
utxt.a:	block 4*13
utxt.b:	block 4*13
 
%msini:	push	p,t1
	move	t1,[ascii /     /]
	movem	t1,mtxt.b
	move	t1,[xwd mtxt.b,mtxt.b+1]
	blt	t1,mtxt.b+12
%msi.1:	move	t1,[point 7,mtxt.b]
	movem	t1,.mpptr
	movem	t1,.mwptr
	pop	p,t1
	ret
 
%mschr:	hrrz	ap,.jbuuo
	move	ap,(ap)
	idpb	ap,.mwptr
	ret
 
%msimm:	hrrz	ap,.jbuuo
	move	ap,(ap)
	outchr	ap
	idpb	ap,.mwptr
	push	p,t1
	move	t1,.mwptr
	subi	t1,54
	dpb	ap,t1
	pop	p,t1
	ret
 
%msstr:	push	p,t1
	hrrz	ap,.jbuuo
	move	t1,[point 7,0]
	add	t1,ap
%mss.1:	ildb	ap,t1
	jumpe	ap,%mss.2
	idpb	ap,.mwptr
	jrst	%mss.1
%mss.2:	pop	p,t1
	ret
 
%mspos:	hrrz	ap,.jbuuo
	soj	ap,
	adjbp	ap,.mpptr
	movem	ap,.mwptr
	ret
 
%msout:	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4
	push	p,row
	push	p,col
	call	%mso.1
	pop	p,col
	pop	p,row
	pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1
	ret
 
%mso.1:	move	t1,[point 7,mtxt.a]
	movem	t1,.mptra
	move	t1,[point 7,mtxt.b]
	movem	t1,.mptrb
	movei	col,6
	setzm	.mcol
%mso.2:	ildb	t1,.mptra
	ildb	t2,.mptrb
	came	t1,t2
	  call	%mso.3
	caige	col,^d59
	aoja	col,%mso.2
	skipe	.mcol
	outstr	[asciz/8/]
	ret
 
%mso.3:	skipg	.mcol
	  jrst	%mso.4
	camg	col,.mcol
	  jrst	%mso.4
	move	t3,col
	sub	t3,.mcol
	soje	t3,%mso.5
	outstr	[asciz/[/]
	caie	t3,1
	  call	%mso.6
	outstr	[asciz/C/]
	jrst	%mso.5
%mso.4:	outstr	[asciz/[23;/]
	move	t3,col
	call	%mso.6
	outstr	[asciz/H/]
%mso.5:	outchr	t2
	dpb	t2,.mptra
	movem	col,.mcol
	ret
 
%mso.6:	idivi	t3,^d10
	tro	t3,"0"
	tro	t4,"0"
	caie	t3,"0"
	outchr	t3
	outchr	t4
	ret
 
%msclr:	move	ap,[ascii /     /]
	movem	ap,mtxt.a
	move	ap,[xwd mtxt.a,mtxt.a+1]
	blt	ap,mtxt.a+25
	ret
 
.mpptr:	z
.mwptr:	z
.mptra:	z
.mptrb:	z
.mcol:	z
 
mtxt.a:	block	13
mtxt.b:	block	13

ifn tops20,<
.sichw:	save	t1
	pbin
	hrrz	ap,.jbuuo
	cain	ap,t1
	 movei	ap,0(p)
	cain	ap,ap
	 movei	ap,-2(p)
	movem	t1,(ap)
	rest	t1
	ret

.sostr:	save	t1
	hrrz	t1,.jbuuo
	cain	t1,t1
	 movei	t1,0(p)
	cain	t1,ap
	 movei	t1,-2(p)
	tlo	t1,-1
	psout
	rest	t1
	ret

.sochr:	pop	p,(p)			;prune pdl
	move	ap,0(p)			;restore ap
	movem	t1,0(p)			;save t1
	move	t1,@.jbuuo
	pbout
	rest	t1
	ret				;exit from LUUO
>



ifn tops20,<
EV::	jrst	boots
	jrst	boots
	byte (3)tk.who (9)tk.ver (6)tk.min (18)tk.edt
>

TREK::
ife tops20,<
	setz	t1,
	setuwp	t1,
	  skip
	setzm	dbugf
	skipe	.jbddt
	 setom	dbugf
>
	move	sp,[iowd pdlsz,pdl]	;set up the push down list
ifn tops20,<
	move	t1,segver
	came	t1,ev+2		;same version?
	 jrst	vererr		;nope - srry
>
	call	inipsi
	call	vtini
	skipn	dbugf
	 call	vtest
	  call	fintty
	call	setup
	movei	c,cctrap
ife tops20,<movem c,ivb>
ifn tops20,<hrrm c,chntab+1>
	call	vtest
	 jrst	trek1
	type	<>
	skipn	dbugf
	call	dspcon
	call	enedsp
	call	shldsp
trek1:	call	wrpdsp
	call	rotran
	call	obload
	dspclr
	mspclr
	setzm	t.time
	setzm	t.more
TRMAIN::
	call	vtcmd
	skipge	t1,c.imm
	  jrst	[skipe	t.more
		   call	@t.more
		 jrst	trmain]
	skipe	t.more
	  jrst	[setzm	t.more
		 morclr
		 jrst	.+1]
	move	ap,c.dir
	cain	ap,5
	  jrst	[call	help
		 jrst	trmain]
	jumpe	t1,tr.cmd
tr.imm:	skipe	t.more
	  jrst	[setzm	t.more
		 morclr
		 jrst	.+1]
	call	@[srscan
		  srscan
		  srscan
		  srscan
		  lrscan
		  rfphas
		  rfphot]-1(t1)
	jrst	trmain
tr.cmd:	skipe	t.more
	  jrst	[setzm	t.more
		 morclr
		 jrst	.+1]
	move	t1,c.cmd
	jumpe	t1,trmain
	call	@[spec
		  tlock
		  refuel
		  shield
		  target
		  phaser
		  photon
		  motion
		  rotate
		  warp
		  dsplst
		  captur
		  trnsfr
		  bases
		  nearb
		  alibr
		  flibr
		  klibr
		  plibr
		  send
		  help
		  users
		  help
		  help
		  quit
		  quit
		  rfresh
		  slftst
		  rapfir
		  score
		  assist
		  ralert
		  yalert
		  salert
		  flibb
		  flibp
		  flibs
		  klibb
		  klibp
		  klibs
		  plibn]-1(t1)
	jrst	trmain
 
ife tops20,<reloc>
 
;*****	SRSCAN
;
;	short range sensor scan.  search depends on the value of the
;	immediate flag:
;
;	  i = fed, 2 = kli, 3 = planet, 4 = anything
 
SRSCAN::
	call	lstclr
	skipe	t.more
	  jrst	[move	uot,t.mor1
		 move	ap,t.mor2
		 movem	ap,c.imm
		 move	ap,t.mor3
		 movem	ap,s.mask
		 setzm	t.more
		 morclr
		 jrst	sr.mor]
	seto	uot,
	hrrz	t2,c.imm
	caile	t2,2
	  jrst	sr.nxt
	lsh	t2,4
	movem	t2,s.mask
sr.nxt:	call	sscan
	  jrst	sr.end
	cail	lst,4
	  jrst	[movem	uot,t.mor1
		 move	ap,c.imm
		 movem	ap,t.mor2
		 move	ap,s.mask
		 movem	ap,t.mor3
		 movei	ap,srscan
		 movem	ap,t.more
		 jrst	sr.end]
sr.mor:	aoj	lst,
	movem	uot,luot.b(lst)
	call	catalg
	jrst	sr.nxt
sr.end:	skipg	lst
	  jrst	[mspini
		 msptyp	<nothing detected by short-range sensors>
		 mspout
		 ret]
	move	ap,[xwd luot.b,luot.a]
	blt	ap,luot.a+4
	call	lstout
	skipe	t.more
	  mordsp
	ret
 
sscan:	call	stdscn
	  ret
	fix	ap,o.rang(uot)
	caile	ap,^d1024
	  jrst	sscan
	hrrz	ap,c.imm
	cain	ap,3
	  jrst	ss.hit
	caie	ap,4
	  jrst	[hrrz	ap,u.tab(uot)
		 xor	ap,s.mask
		 trne	ap,3b31
		 jrst	sscan
		 jrst	ss.hit]
	caie	t1,2
	cain	t1,7
	  skipa
	jrst	sscan
ss.hit:	aos	(p)
	ret
 
LRSCAN::
	call	tarscn
	  jrst	[mspini
		 msptyp	<nothing detected by long-range sensors>
		 mspout
		 ret]
	call	lstclr
	aoj	lst,
	movem	uot,luot.b(lst)
	call	catalg
	move	ap,[xwd luot.b,luot.a]
	blt	ap,luot.a+4
	dspini
	call	lstdsp
	call	lrshld
	dspout
	ret
 
LRSHLD::
	move	ap,u.tab(uot)
	andi	ap,17
	caie	ap,7
	caig	uot,17
	skipa
	  ret
	dspini	2
	dsptyp	<  shields >
	skiple	t3,u.shld(uot)
	  jrst	[dsptyp	<UP >
		 idivi	t3,^d1000
		 call	nbrout
		 ret]
	movm	t3,t3
	dsptyp	<DN >
	idivi	t3,^d1000
	call	nbrout
	dsptyp	<, energy >
	move	t3,u.ener(uot)
	idivi	t3,^d1000
	call	nbrout
	ret
 
SPEC::
	skipn	dbugf
;	skipa
	  jrst	[dspini
		 dsptyp	<SPACE!  The Final Frontier!>
		 dspout
		 ret]
	call	lstclr
	skipe	t.more
	  jrst	[move	uot,t.mor1
		 move	ap,t.mor2
		 movem	ap,c.nbr1
		 setzm	t.more
		 morclr
		 jrst	sp.mor]
	seto	uot,
sp.nxt:	call	getlib
	  jrst	sp.end
	cail	lst,4
	  jrst	[movem	uot,t.mor1
		 move	ap,c.nbr1
		 movem	ap,t.mor2
		 movei	ap,spec
		 movem	ap,t.more
		 jrst	sp.end]
sp.mor:	aoj	lst,
	movem	uot,luot.b(lst)
	call	catalg
	jrst	sp.nxt
sp.end:	skipg	lst
	  jrst	[mspini
		 msptyp	<not found>
		 mspout
		 ret]
	move	ap,[xwd luot.b,luot.a]
	blt	ap,luot.a+4
	call	lstout
	skipe	t.more
	  mordsp
	ret
 
getlib:	aoj	uot,
	caile	uot,217
	  ret
	camn	uot,suot
	  jrst	getlib
	skipge	t1,u.tab(uot)
	  jrst	getlib
	skipe	c.nbr1
	  jrst	[andi	t1,17
		 came	t1,c.nbr1
		 jrst	getlib
		 jrst	.+1]
	aos	(p)
	ret
 
TLOCK::
	call	getobj
	  ret
	fix	t1,o.rang(uot)
	caile	t1,^d1024
	  jrst	[mspini
		 msptyp	<target object not within 1024 units>
		 mspout
		 ret]
	movem	uot,t.uot
	call	conuot
	move	t1,b1
	movem	t1,t.bear
	move	t1,e1
	movem	t1,t.elev
	call	contrc
	call	tardsp
	type	<8>
	mspini
	msptyp	<target locked>
	mspout
	ret
 
SYNCH::
	move	t1,t.bear
	movem	t1,b1
	move	t1,t.elev
	movem	t1,e1
	setzm	t.bear
	setzm	t.elev
	movei	row,7
	movei	col,^d41
	call	tardsp
	type	<8>
	call	rot.zy
	call	obload
	ret
 
SHIELD::
	move	t2,c.dir
	caile	t2,2
	  jrst	shl.er
	move	t1,c.cnt
	jumpe	t1,shl.st
	move	t1,c.nbr1
	caige	t1,0
	  jrst	shl.er
	imuli	t1,^d1000
	movem	t1,f.data
	movm	t2,u.shld(suot)
	sub	t1,t2
	call	enetst
	  ret
	move	t1,f.data
	skipa
shl.st:	movm	t1,u.shld(suot)
	move	t2,c.dir
	caig	t2,0
	skipl	u.shld(suot)
	cain	t2,2
	movn	t1,t1
	movem	t1,u.shld(suot)
	call	shldsp
	ret
shl.er:	type	<>
	ret
 
TARGET::
	setom	t.uot
	move	t1,c.cnt
	move	t2,c.dir
	jrst	@[ta.c0
		  ta.c1
		  ta.c2](t1)
	ret
 
ta.c0:	call	tarfnd
	  skip
	ret
 
ta.00:	mspini
	msptyp	<target reset>
	mspout
	setzm	t.bear
	setzm	t.elev
	call	contrc
	call	tardsp
	ret
 
ta.c1:	fltr	t3,c.nbr1
	jrst	@[ta.d0
		  ta.d1
		  ta.d2
		  ta.d3
		  ta.d4](t2)
	ret
 
ta.d0:	jumpe	t3,ta.00
	call	getlst
	ret
	move	t3,b1
	movem	t3,t.bear
	move	t3,e1
	movem	t3,t.elev
	call	contrc
	call	tardsp
	ret
 
ta.d1:	move	t4,t.elev
	fadr	t4,t3
	jrst	ta.d21
ta.d2:	move	t4,t.elev
	fsbr	t4,t3
ta.d21:	movem	t4,t.elev
	jrst	ta.dd
ta.d3:	move	t4,t.bear
	fadr	t4,t3
	jrst	ta.d41
ta.d4:	move	t4,t.bear
	fsbr	t4,t3
ta.d41:	movem	t4,t.bear
ta.dd:	call	contrc
	call	tardsp
	ret
 
ta.c2:	fltr	t3,c.nbr1
	movem	t3,t.bear
	fltr	t3,c.nbr2
	movem	t3,t.elev
	call	contrc
	call	tardsp
	ret
 
TRNSFR::
	movei	t1,^d200
	skipe	c.cnt
	  move	t1,c.nbr1
	caile	t1,0
	caile	t1,^d1000
	  jrst	[type	<>
		 ret]
	movem	t1,p.ener
	imul	t1,t1
	movem	t1,p.time
	move	t1,p.ener
	imuli	t1,^d1000
	skiple	u.shld(suot)
	  jrst	[mspini
		 mspstr	@o.name(suot)
		 msptyp	< shields are up>
		 mspout
		 ret]
	call	enetst
	  ret
	move	t1,p.time
	idivi	t1,^d100
	caige	t1,^d2000
	  movei	t1,^d2000
	movem	t1,p.time
	setz	t2,
	call	pflash
	call	tarscn
	  jrst	trs.wt
	fixr	t1,o.rang(uot)
	caile	t1,^d1024
	  jrst	trs.wt
	movem	t1,eadd.t
	move	t1,p.ener
	call	eneadd
	caile	uot,7
	  jrst	trs.wt
	movei	t1,2000
	lsh	t1,@uot
	ior	t1,suot
	hrli	t1,10
	movsm	t1,eadd.a
	movem	uot,eadd.b
	call	lqadd
trs.wt:	move	t1,p.time
	pjrst	trwait
 
SCORE::
	setzm	n.nuot
	move	c,[xwd n.nuot,n.nuot+1]
	blt	c,n.nuot+7
	movei	t1,120
sco.1:	sojl	t1,sco.3
	skipge	c,u.tab(t1)
	  jrst	sco.1
	andi	c,17
	cail	c,7
	  jrst	sco.1
	caie	c,2
	  jrst	sco.2
	move	t2,u.tab(t1)
	trne	t2,@ally.n
	  jrst	sco.1
	trne	t2,@ally.f
	  soj	c,
sco.2:	aos	n.nuot(c)
	jrst	sco.1
sco.3:	save	p1,p2,p3
	dspini	1
	dsptyp	<Active status:>
	dspini	2
	dsptyp	<  Federation:>
	move	p1,n.nuot+5
	move	p2,n.nuot+3
	move	p3,n.nuot+1
	call	sco.4
	dspini	3
	dsptyp	<  Klingon Empire:>
	move	p1,n.nuot+6
	move	p2,n.nuot+4
	move	p3,n.nuot+2
	call	sco.4
	dspini	4
	dspout
	rest	p1,p2,p3
	ret
 
sco.4:	dsppos	^d20
	move	t1,p1
	call	nbrfix
	dsptyp	< ship>
	caie	p1,1
	   dsptyp <s>
	dsppos	^d31
	move	t1,p2
	call	nbrfix
	dsptyp	< base>
	caie	p2,1
	  dsptyp <s>
	dsppos	^d42
	move	t1,p3
	call	nbrfix
	dsptyp	< planet>
	caie	p3,1
	  dsptyp <s>
	ret
 
ASSIST::
	setz	t1,
	call	alerts
	mspini
	msptyp	<assistance requested>
	mspout
	ret
 
RALERT::
	movei	t1,1
	call	alerts
	mspini
	msptyp	<RED ALERT>
	mspout
	ret
 
YALERT::
	movei	t1,2
	call	alerts
	mspini
	msptyp	<YELLOW ALERT>
	mspout
	ret
 
SALERT::
	movei	t1,3
	call	alerts
	mspini
	msptyp	<secure from alert>
	mspout
	ret
 
ALERTS::
	move	uot,suot
	move	c,mask.u
	movem	c,s.mask
	pjrst	alert
 
ALERT::
	movei	t2,2000
	lsh	t2,@uot
	movei	t3,sh.mx
alr.1:	camn	t3,uot
	  jrst	alr.2
	andcam	t2,u.alrt(t3)
	caig	t1,1
	  iorm	t2,u.alrt(t3)
alr.2:	sojge	t3,alr.1
	hrlz	c,t1
	hrr	c,uot
	movem	c,eadd.b
	move	c,s.mask
	trz	c,@t2
	hrli	c,12
	movsm	c,eadd.a
	setzm	eadd.t
	pjrst	lqins
 
RAPFIR::
	mspini
	skipn	c.nbr1
	skipe	c.nbr2
	skipa
	  jrst	[setzm	r.fire
		 msptyp	<weapons in normal mode>
		 mspout
		 type	<PHATOR8>
		 ret]
	skipn	t1,c.nbr1
	  movei	t1,^d200
	caile	t1,0
	caile	t1,^d1000
	  jrst	rf.err
	skipn	t2,c.nbr2
	  movei	t2,1
	caile	t2,0
	caile	t2,3
	  jrst	rf.err
	movem	t1,rf.pha
	movem	t2,rf.pho
	setom	r.fire
	msptyp	<weapons in rapid fire mode>
	mspout
	type	<PHATOR8>
	ret
 
rf.err:	type	<>
	ret
 
RFPHAS::
	push	p,c.cnt
	push	p,c.nbr1
	move	c,rf.pha
	movem	c,c.nbr1
	movei	c,1
	movem	c,c.cnt
	call	phaser
	pop	p,c.nbr1
	pop	p,c.cnt
	ret
 
PHASER::
	movei	t1,^d200
	skipe	c.cnt
	move	t1,c.nbr1
	caile	t1,0
	caile	t1,^d1000
	  jrst	[type	<>
		 ret]
	movem	t1,p.ener
	imul	t1,t1
	movem	t1,p.time
	call	enetst
	  ret
	move	t1,p.time
	idivi	t1,^d75
	caige	t1,^d3000
	movei	t1,^d3000
	movem	t1,p.time
	setz	t2,			;weapons code (phaser = 0)
	call	pflash
	call	tarscn
	  jrst	pha.wt
	fixr	t1,o.rang(uot)
	caile	t1,^d1024
	  jrst	pha.wt
	setz	t2,			;weapons code (phaser = 0)
	call	pqadd
pha.wt:	move	t1,p.time
	pjrst	trwait
 
RFPHOT::
	push	p,c.cnt
	push	p,c.nbr1
	move	c,rf.pho
	movem	c,c.nbr1
	movei	c,1
	movem	c,c.cnt
	call	photon
	pop	p,c.nbr1
	pop	p,c.cnt
	ret
 
PHOTON::
	movei	t1,1
	skipe	c.cnt
	move	t1,c.nbr1
	cail	t1,1
	caile	t1,3
	  jrst	[type	<>
		 ret]
	camle	t1,u.torp(suot)
	  jrst	[mspini
		 msptyp	<insufficient torpedos for burst>
		 mspout
		 ret]
	movem	t1,p.save
	imuli	t1,^d40000
	call	enetst
	  ret
	movei	t1,^d200
	movem	t1,p.ener
pho.sr:	sos	u.torp(suot)
	hrrzi	t2,1b27			;weapons code (photon = 1)
	call	pflash
	call	tarscn
	  jrst	pho.wt
	fixr	t1,o.rang(uot)
	addi	t1,^d2000
	hrrzi	t2,1b27			;weapons code (photon = 1)
	call	pqadd
pho.wt:	movei	t1,^d2000
	call	trwait
	sosle	p.save
	  jrst	pho.sr
	ret
 
;*****	PFLASH
 
PFLASH::
	ior	t2,mask.o
	hrli	t2,4			;weapons fire event code
	movsm	t2,eadd.a
	movem	suot,eadd.b
	setzm	eadd.t
	push	sp,t2
	call	lqadd
	pop	sp,t2
	trnn	t2,1b27
	  pjrst	pha.fl
	pjrst	pho.fl
 
pha.fl:	move	row,t.row
	move	col,t.col
	call	rctest
	  ret
	call	vtpos
	type	<>
	movei	t1,^d10
	type	<(1 (B>
	sojg	t1,.-1
	type	<>
	call	getvwr
	call	dspvwr
	type	<8>
	ret
 
pho.fl:	move	row,t.row
	move	col,t.col
	movei	c,flsh03
	movem	c,flsh.p
	call	flshld
	type	<(1>
	call	flshbr
	type	<(B8>
	call	flshch
	type	<8>
	ret
 
;*****	PQADD
 
PQADD::
	movem	t1,eadd.t
	caile	uot,sh.mx
	  jrst	pqa.1
	move	t1,u.tab(uot)
	tlnn	t1,1b19
	  jrst	pqa.1
	movei	t1,2000
	lsh	t1,@uot
	skipa
pqa.1:	move	t1,mask.c
	ior	t1,suot
	ior	t1,t2			;weapons code
	hrli	t1,5			;hit request event code
	movsm	t1,eadd.a
	hrl	t1,p.ener
	hrr	t1,uot
	movem	t1,eadd.b
	move	t1,u.absx(uot)
	movem	t1,eadd.x
	move	t1,u.absy(uot)
	movem	t1,eadd.y
	move	t1,u.absz(uot)
	movem	t1,eadd.z
	pjrst	lqadd
 
MOTION::
	move	t2,c.dir
	caie	t2,3
	cain	t2,4
	  jrst	rolshp
	move	t3,s.warp
	move	t2,c.cnt
	cain	t2,2
	  jrst	mot.a
	caie	t2,1
	  jrst	mot.t
	skipe	c.dir
	  jrst	mot.b
mot.ls:	call	getlst
	  ret
	call	rot.zy
	jrst	mot.c
mot.b:	skipl	t3,c.nbr1
	caile	t3,^d9
	  jrst	[type	<>
		 ret]
	jrst	mot.c
mot.a:	fltr	t1,c.nbr1
	movem	t1,b1
	fltr	t1,c.nbr2
	movem	t1,e1
	call	rot.zy
	jrst	mot.c
mot.t:	skipn	c.dir
	  call	rottar
mot.c:	move	t1,wf.tab(t3)
	movem	t1,f.data
	move	t2,c.dir
	cain	t2,2
	movnm	t1,f.data
	imul	t1,t1
	call	enetst
	  pjrst	obload
	call	movshp
	hrlz	t1,mask.o
	hrri	t1,1			;movement event code
	movem	t1,eadd.a
	movem	suot,eadd.b
	setzm	eadd.t
	call	hqadd
	call	obload
	pjrst	ifnear
 
movshp:	fltr	t1,f.data
	fmpr	t1,s.11
	fadrm	t1,u.absx(suot)
	fltr	t1,f.data
	fmpr	t1,s.12
	fadrm	t1,u.absy(suot)
	fltr	t1,f.data
	fmpr	t1,s.13
	fadrm	t1,u.absz(suot)
	ret
 
rolshp:	skipg	c.cnt
	ret
	move	t1,c.nbr1
	cain	t2,3
	movn	t1,c.nbr1
	fltr	t1,t1
	call	sincos
	call	rot.x
	call	obload
	ret
 
IFNEAR::
	seto	uot,
ifnr.1:	call	stdscn
	  ret
	caile	t1,4		;test only bases and planets
	  jrst	ifnr.1
	move	ap,u.tab(uot)
	trnn	ap,3b31		;test if neutral
	  jrst	ifnr.1		;don't perturb neutral entities
	setz	t1,
	fix	ap,o.rang(uot)
	caig	ap,^d1024
	  call	tqins
	jrst	ifnr.1
 
ROTATE::
	skipg	t1,c.cnt
	  jrst	rot.d
	cain	t1,2
	  jrst	rot.2
	skipg	t2,c.dir
	  jrst	rot.ls
	move	t1,c.nbr1
	caie	t2,2
	cain	t2,4
	  movn	t1,t1
	fltr	t1,t1
	call	sincos
	movei	c,rot.z
	caig	t2,2
	  movei	c,rot.y
	call	@c
	pjrst	obload
rot.ls:	call	getlst
	  ret
	call	rot.zy
	pjrst	obload
rot.d:	skipg	t2,c.dir
	  jrst	rot.t
	call	tarfnd
	  ret
rot.t:	call	rottar
	pjrst	obload
rot.2:	fltr	t1,c.nbr1
	movem	t1,b1
	fltr	t1,c.nbr2
	movem	t1,e1
	call	rot.zy
	pjrst	obload
 
ROTTAR::
	move	t1,t.bear
	movem	t1,b1
	move	t1,t.elev
	movem	t1,e1
	call	rot.zy
	setzm	t.bear
	setzm	t.elev
	movei	row,7
	movem	row,t.row
	movei	col,^d41
	movem	col,t.col
	ret
 
WARP::
	skipn	t1,c.cnt
	  jrst	wrp.ds
	move	t2,c.nbr1
	caige	t2,0
	jrst	wrp.er
	caile	t2,^d9
	jrst	wrp.er
	caie	t1,2
	jrst	wrp.ex
	move	t3,c.nbr2
	caige	t3,0
	jrst	wrp.er
	caile	t3,^d1000
	jrst	wrp.er
	movem	t3,wf.tab(t2)
wrp.ex:	movem	t2,s.warp
	call	wrpdsp
	ret
 
wrp.ds:	dspini	1
	dsptyp	<Warp distances:>
	dspini	2
	dsptyp	<  w0:>
	move	t1,wf.tab
	call	nbrfix
	dsptyp	<    w1:>
	move	t1,wf.tab+1
	call	nbrfix
	dsptyp	<    w2:>
	move	t1,wf.tab+2
	call	nbrfix
	dsptyp	<    w3:>
	move	t1,wf.tab+3
	call	nbrfix
	dsptyp	<    w4:>
	move	t1,wf.tab+4
	call	nbrfix
	dspini	3
	dsptyp	<  w5:>
	move	t1,wf.tab+5
	call	nbrfix
	dsptyp	<    w6:>
	move	t1,wf.tab+6
	call	nbrfix
	dsptyp	<    w7:>
	move	t1,wf.tab+7
	call	nbrfix
	dsptyp	<    w8:>
	move	t1,wf.tab+8
	call	nbrfix
	dsptyp	<    w9:>
	move	t1,wf.tab+9
	call	nbrfix
	dspini	4
	dspout
	ret
 
wrp.er:	type	<>
	ret
	ret
 
DSPLST::
	skipe	t1,c.nbr1
	  pjrst	dspany
	movei	lst,4
	skipl	luot.a(lst)
	  pjrst	lstout
	sojg	lst,.-2
	mspini
	msptyp	<object list is empty>
	mspout
	ret
 
DSPANY::
	cail	t1,1
	caile	t1,30
	  jrst	[type	<>
		 ret]
	move	uot,o.nbr-1(t1)
	skipl	c,u.tab(uot)
	trnn	c,@mask.c
	  jrst	[mspini

		 msptyp	<nothing found by library computer>
		 mspout

		 ret]
	call	lstclr
	aoj	lst,
	movem	uot,luot.b(lst)
	move	c,[xwd luot.b,luot.a]
	blt	c,luot.a+4
	pjrst	lstout
 
CAPTUR::
	call	getobj
	  ret
	hrrz	t2,u.tab(uot)
	andi	t2,7
	caie	t2,2
	  jrst	ca.np
	move	t2,o.rang(uot)
	camle	t2,[512.0]
	  jrst	ca.re
	move	t2,u.tab(uot)
	tlne	t2,100
	  jrst	ca.up
	move	t2,u.tab(uot)
	trz	t2,7b31
	ior	t2,ally.u
	movem	t2,u.tab(uot)
	call	catalg
	mspini
	msptyp	<planet captured>
	mspout
	call	rebtim
	movem	t1,rebel(uot)
	ret
ca.np:	call	ca.id
	msptyp	< is not a planet>
	mspout
	ret
ca.re:	call	ca.id
	msptyp	< is not within 512 units>
	mspout
	ret
ca.id:	mspini
	jumpe	t1,[msptyp  <target object>
		    ret]
	msptyp	<object >
	tro	t1,"0"
	mspchr	t1
	ret
ca.up:	setz	t1,
	call	tqins
	mspini
	msptyp	<planetary defenses are up>
	mspout
	ret
 
REFUEL::
	movei	uot,7
	call	nscanp
	  jrst	ref.er
	camle	t3,[512.0]
	  jrst	ref.er
	move	t1,suot
	move	t2,uot
	call	reener
	call	enedsp
	movei	t1,^d1500
	pjrst	trwait
ref.er:	mspini
	msptyp	<not within 512 units of a base>
	mspout
	ret
 
;*****	REENER
;
;	refuels ship T1 from base (or planet) T2.
 
REENER::
	save	t2
	move	t2,u.tab(t2)
	andi	t2,17
	move	c,u.torp(t1)
	addi	c,3
	caie	t2,2
	  addi	c,2
	caile	c,^d10
	  movei	c,^d10
	movem	c,u.torp(t1)
	move	c,[^d250000]
	caie	t2,2
	  add	c,c
	addb	c,u.ener(t1)
	movm	t2,u.shld(t1)
	add	c,t2
	camle	c,[^d5000000]
	  jrst	[move	c,[^d5000000]
		 sub	c,t2
		 movem	c,u.ener(t1)
		 jrst	.+1]
	rest	t2
	ret
 
NEARB::
	call	lstclr
	movei	uot,7
	call	nscanb
	  jrst	nrb.2
	aoj	lst,
	movem	uot,luot.b(lst)
nrb.2:	movei	uot,17
	call	nscanp
	  jrst	nrb.3
	aoj	lst,
	movem	uot,luot.b(lst)
nrb.3:	skipg	lst
	  jrst	[mspini
		 msptyp	<nothing found by library computer>
		 mspout
		 ret]
	move	ap,[xwd luot.b,luot.a]
	blt	ap,luot.a+4
	call	lstout
	ret
 
NSCANB:	movei	t2,17		;don't include planets
	skipa
NSCANP:	movei	t2,117
	setzb	t3,t4
nsc.1:	aoj	uot,
	camle	uot,t2
	  jrst	nsc.2
	skipge	t1,u.tab(uot)
	  jrst	nsc.1
	andi	t1,17
	move	c,ally.u
	caie	t1,7
	tdnn	c,u.tab(uot)
	  jrst	nsc.1
	jumpe	t3,nsc.11
	camg	t3,o.rang(uot)
	  jrst	nsc.1
nsc.11:	move	t3,o.rang(uot)
	move	t4,uot
	jrst	nsc.1
nsc.2:	skipe	uot,t4
	  aos	(p)
	ret
 
PLIBN::	move	c,ally.n
	movem	c,s.mask
	skipa
PLIBR::	setzm	s.mask
	setzm	s.muid
	movei	uot,17
	pjrst	libscn
 
ALIBR::	seto	uot,
	setzm	s.mask
	setzm	s.muid
	pjrst	libscn
 
FLIBB::	movei	c,3
	jrst	flib
FLIBP::	movei	c,2
	jrst	flib
FLIBS::	movei	c,5
	jrst	flib
FLIBR::	setz	c,
FLIB::	movem	c,s.muid
	move	c,ally.f
	movem	c,s.mask
	seto	uot,
	pjrst	libscn
 
KLIBB::	movei	c,4
	jrst	klib
KLIBP::	movei	c,2
	jrst	klib
KLIBS::	movei	c,6
	jrst	klib
KLIBR::	setz	c,
KLIB::	movem	c,s.muid
	move	c,ally.k
	movem	c,s.mask
	seto	uot,
	pjrst	libscn
 
BASES::
	move	c,ally.u
	movem	c,s.mask
	setzm	s.muid
	movei	uot,7
	pjrst	libscn
 
SEND::
	move	t1,c.nbr1
	caig	t1,2
	jrst	send.1
	move	uot,t1
	subi	uot,3
	skipge	u.tab(uot)
	jrst	sen.na
send.1:	movei	row,^d21
	movem	row,m.row
	call	getmsg
	ret
	call	movmsg
	move	t2,c.nbr1
	cail	t2,3
	jrst	[movei	t1,200
		 lsh	t1,@t2
		 jrst	send.2]
	move	t1,@[mask.a
		  mask.f
		  mask.k](t2)
	trz	t1,@mask.c
send.2:	hrli	t1,3			;message event code
	movsm	t1,eadd.a
	movem	suot,eadd.b
	setzm	eadd.t
	pjrst	lqadd
sen.na:	mspini
	mspstr	@o.name(uot)
	msptyp	< not available>
	mspout
	ret
 
MOVMSG::
	push	sp,t1
	push	sp,t2
	move	t1,suot
	imuli	t1,^d11
	addi	t1,u.msg
	move	t2,t1
	hrli	t1,m.msg
	blt	t1,^d10(t2)
	pop	sp,t2
	pop	sp,t1
	ret
 
USERS::
	call	lstclr
	skipe	t.more
	  jrst	[move	uot,t.mor1
		 setzm	t.more
		 morclr
		 jrst	usr.mr]
	movei	uot,10
usr.nx:	sojl	uot,usr.en
	skipl	c,u.tab(uot)
	tlnn	c,1b19
	  jrst	usr.nx
	cail	lst,4
	  jrst	[movem	uot,t.mor1
		 movei	ap,users
		 movem	ap,t.more
		 jrst	usr.en]
usr.mr:	aoj	lst,
	movem	uot,luot.b(lst)
	jrst	usr.nx
usr.en:	skipg	lst
	  jrst	[mspini
		 msptyp	<no ships in play>
		 mspout
		 ret]
	dspini
usr.ot:	skipl	uot,luot.b(lst)
	  call	usrout
	sojg	lst,usr.ot
	dspout
	skipe	t.more
	  mordsp
	ret
 
USROUT::
	dspini	(lst)
	dspstr	@o.name(uot)
	dsppos	^d16
ife tops20,<
	move	t4,u.tty(uot)
	call	sixout
	dsptyp	<   >
	move	t4,u.nam1(uot)
	call	sixout
	move	t4,u.nam2(uot)
	call	sixout
	dsptyp	<   >
	move	t4,u.ppn(uot)
	call	ppnout
>
ifn tops20,<
	dsptyp	<TTY>
	move	t2,u.tty(uot)
	call	octout
	dsptyp	<   >
	hrroi	t1,io.blk
	move	t2,u.namx(uot)
	dirst
	 jfcl
	dspstr	io.blk
>
	ret
 
ife tops20,<
SIXOUT::
	movei	t1,6
	setz	t3,
	lshc	t3,6
	addi	t3,40
	dspchr	t3
	sojg	t1,.-4
	ret
 
PPNOUT::
	dsptyp	<[>
	hlrz	t2,t4
	call	octout
	dsptyp	<,>
	hrrz	t2,t4
	call	octout
	dsptyp	<]>
	ret
>
 
OCTOUT::
	idivi	t2,10
	push	p,t3
	skipe	t2
	call	octout
	pop	p,t3
	addi	t3,"0"
	dspchr	t3
	ret
 
HELP::
	dspini
	skipe	t.more
	  jrst	[setzb	t3,t.more
		 morclr
		 jrst	hlp.m]
	call	closin
	call	openin
	  jrst	hlp.nf
	move	t3,c.cmd
	hrrz	t3,c.tab(t3)
hlp.1:	call	readin
	  jrst	hlp.nf
	move	t1,[point 7,io.blk]
	ildb	t2,t1
hlp.2:	caie	t2,"."
	  jrst	hlp.1
	ildb	ap,t1
	lsh	ap,7
	ildb	t2,t1
	cail	t2,"A"
	caile	t2,"Z"
	  jrst	[iori	ap," "
		 jrst	hlp.21]
	  ior	ap,t2
	  ildb	t2,t1
hlp.21:	came	ap,t3
	  jrst	hlp.2
	setz	t3,
hlp.3:	call	readin
	  jrst	hlp.4
	move	t1,[point 7,io.blk]
	ildb	t2,t1
	cain	t2,"."
	  jrst	hlp.4
	cail	t3,4
	  jrst	[movei	ap,help
		 movem	ap,t.more
		 dspout
		 mordsp
		 ret]
hlp.m:	aoj	t3,
	dspini	(t3)
	dspstr	io.blk
	jrst	hlp.3
hlp.4:	dspout
	call	closin
	ret
 
hlp.nf:	mspini
	msptyp	<no help available>
	mspout
	ret
 
OPENIN::
ife tops20,<
	move	c,[sixbit /VTTREK/]
	movem	c,lk.nam
	move	c,[sixbit /HLP/]
	movem	c,lk.ext
	skipe	dbugf
	  jrst	op.1
	move	ap,[xwd -1,135]		;get run device
	gettab	ap,
	  skipa
	movem	ap,op.dev
	move	ap,[xwd -1,136]		;get run ppn
	gettab	ap,
	  skipa
	movem	ap,lk.ppn
op.1:	open	hlpchn,op.blk
	  ret
	lookup	hlpchn,lk.blk
	  ret
	setzm	in.cnt
	retskp
> 
ifn tops20,<
	save	t1,t2
	hrroi	t1,[asciz /HLP/]
	movem	t1,gjblk+.gjext
	setz	t2,
	movei	t1,gjblk
	gtjfn
	 jrst	openix
	movem	t1,hlpjfn
	movx	t2,7b5+of%rd
	openf
	 jrst	[move t1,hlpjfn
		 rljfn
		  jfcl
		 jrst openix]
	aos	-2(p)			;skip return
openix:	pop	p,t2
	pop	p,t1
	ret
>

READIN::
	setzm	io.blk
	move	ap,[xwd io.blk,io.blk+1]
	blt	ap,io.blk+12
	move	ap,[point 7,io.blk]
	movem	ap,io.ptr
	setzm	io.cnt
rd.1:
ifn tops20,<
	move	t1,hlpjfn
	bin
	 erjmp	closin
	cain	t2,15
	 jrst	rd.1
	cain	t2,12
	 retskp
	idpb	t2,io.ptr
>
ife tops20,<
	sosle	in.cnt
	  jrst	rd.2
	in	hlpchn,in.lst
	  jrst	[movei	ap,1200
		 movem	ap,in.cnt
		 move	ap,[point 7,in.blk]
		 movem	ap,in.ptr
		 jrst	rd.2]
	ret
rd.2:	ildb	ap,in.ptr
	skipg	ap
	  jrst	[call	closin
		 ret]
	cain	ap,15
	  jrst	rd.1
	cain	ap,12
	  retskp
	idpb	ap,io.ptr
>
	aos	io.cnt
	jrst	rd.1
 
CLOSIN::
ife tops20,<
	close	hlpchn,
	releas	hlpchn,
>
ifn tops20,<
	save	t1
	move	t1,hlpjfn
	closf
	 jfcl
	setzm	hlpjfn
	rest	t1
>
	ret
 
QUIT::
	type	<>
	call	stwait
	move	c,u.tab(suot)
	tlz	c,1b19
	movem	c,u.tab(suot)
	call	wrapup
	gexit
 
SLFTST::
	type	<>
	movei	t1,^d2000
	call	trwait
	jrst	rfresh
 
RFRESH::
	call	dspcon
	call	enedsp
	call	shldsp
	call	wrpdsp
	skipe	r.fire
	  type	<PHATOR8>
ife tops20,<setzm l.hr>
ifn tops20,<setzm d.tcnt>
	call	d.time
	call	vwrclr
	call	obload
	dspclr
	mspclr
	ret
 
;*****	STDSCN
;
;	scans for active objects, skips stars and our ship.  returns
;	uot in uot and uid in t1.  uot must be initialized to 1 less
;	than the 1st u.tab entry to be scanned.  in most cases, this
;	value is -1.  if object is found, skip return is taken.
 
STDSCN::
	aoj	uot,
	caile	uot,117
	  ret
	camn	uot,suot
	  jrst	stdscn
	skipge	t1,u.tab(uot)
	  jrst	stdscn
	hrrz	t1,t1
	andi	t1,17
	aos	(sp)
	ret
 
;*****	LIBSCN
 
LIBSCN::
	call	lstclr
	skipe	t.more
	  jrst	[move	uot,t.mor1
		 move	ap,t.mor2
		 movem	ap,s.mask
		 setzm	t.more
		 morclr
		 jrst lb.mor]
lb.nxt:	call	lbscn
	  jrst	lb.end
	skipn	s.mask
	  jrst	lb.sc1
	trnn	t1,@s.mask
	  jrst	lb.nxt
lb.sc1:	skipn	s.muid
	  jrst	lb.sc2
	andi	t1,17
	came	t1,s.muid
	  jrst	lb.nxt
lb.sc2:	cail	lst,4
	  jrst	[movem	uot,t.mor1
		 move	ap,s.mask
		 movem	ap,t.mor2
		 movei	ap,libscn
		 movem	ap,t.more
		 jrst	lb.end]
lb.mor:	aoj	lst,
	movem	uot,luot.b(lst)
	jrst	lb.nxt
lb.end:	skipg	lst
	  jrst	[mspini
		 msptyp	<nothing found by library computer>
		 mspout
		 ret]
	move	ap,[xwd luot.b,luot.a]
	blt	ap,luot.a+4
	call	lstout
	skipe	t.more
	  mordsp
	ret
 
lbscn:	aoj	uot,
	caile	uot,117
	  ret
	camn	uot,suot
	  jrst	lbscn
	skipge	t1,u.tab(uot)
	  jrst	lbscn
	trnn	t1,@mask.c
	  jrst	lbscn
	aos	(p)
	ret
 
;*****	GETOBJ
 
GETOBJ::
	skipe	c.dir
	  jrst	go.er
	skipe	t1,c.cnt
	  jrst	go.lst
	call	tarscn
	  jrst	[mspini
		 msptyp	<no object found at target coordinates>
		 mspout
		 ret]
	setz	t1,
	aos	(p)
	ret
go.lst:	caie	t1,1
	  jrst	go.er
	call	getlst
	  skipa
	aos	(p)
	ret
go.er:	type	<>
	ret
 
;*****	TARFND
 
TARFND::
	save	p1,p2,p3,p4
	movei	p1,^d13
	movei	p2,1
	movei	p3,7
	movei	p4,^d75
	camle	p1,t.row
	caml	p2,t.row
	  jrst	tf.nul
	camle	p4,t.col
	caml	p3,t.col
	  jrst	tf.nul
	cain	t2,1
	  move	p1,t.row
	cain	t2,2
	  move	p2,t.row
	cain	t2,3
	  move	p3,t.col
	cain	t2,4
	  move	p4,t.col
	movem	p1,t.rmax
	movem	p2,t.rmin
	movem	p3,t.cmin
	movem	p4,t.cmax
	call	tartst
	  jrst	tf.nul
	call	contrc
	call	tardsp
	type	<8>
	rest	p1,p2,p3,p4
	aos	(sp)
	ret
tf.nul:	mspini
	msptyp	<target not obtained>
	mspout
	rest	p1,p2,p3,p4
	ret
 
 
;*****	TARTST
 
TARTST::
	setz	t3,
	setob	uot,f.hit
tt.nxt:	aoj	uot,
	hrrz	t1,scan.1(uot)
	jumpe	t1,tt.end
	trz	t1,-1000
	camle	t1,t.rmin
	caml	t1,t.rmax
	  jrst	tt.nxt
	hrrz	t2,scan.1(uot)
	lsh	t2,-^d9
	camle	t2,t.cmin
	caml	t2,t.cmax
	  jrst	tt.nxt
	came	t1,t.row
	jrst	.+3
	camn	t2,t.col
	jrst	tt.nxt
	move	t4,t1
	soj	t4,
	imuli	t4,^d78
	add	t4,t2
	adjbp	t4,v.tabp
	ldb	t4,t4
	trz	t4,40
	cain	t4,0
	jrst	tt.nxt
	push	sp,uot
	hlrz	uot,scan.1(uot)
	lsh	uot,-^d9
	call	conuot
	move	t1,b1
	fsbr	t1,t.bear
	fmpr	t1,t1
	move	t2,e1
	fsbr	t2,t.elev
	fmpr	t2,t2
	fadr	t1,t2
	movem	t1,f.data
	movei	ap,f.loc
	call	sqrt.##
	pop	sp,uot
	jumpe	t3,tt.n1
	camg	t3,rs
	jrst	tt.nxt
tt.n1:	move	t3,rs
	move	t1,b1
	movem	t1,w.bear
	move	t1,e1
	movem	t1,w.elev
	setzm	f.hit
	jrst	tt.nxt
tt.end:	skipge	f.hit
	ret
	move	t1,w.bear
	movem	t1,t.bear
	move	t1,w.elev
	movem	t1,t.elev
	aos	(sp)
	ret
 
;*****	TARSCN
 
TARSCN::
	push	sp,p1
	push	sp,p2
	push	sp,p3
	push	sp,p4
	move	p1,t.bear
	fsbr	p1,[0.9]
	move	p2,t.bear
	fadr	p2,[0.9]
	move	p3,t.elev
	fsbr	p3,[2.1]
	move	p4,t.elev
	fadr	p4,[2.1]
	setzb	t3,t4
	setob	uot,f.hit
ts.nxt:	call	rngscn
	  jrst	ts.end
	call	conuot
	camg	p1,b1
	camge	p2,b1
	  jrst	ts.nxt
	camg	p3,e1
	camge	p4,e1
	  jrst	ts.nxt
	jumpe	t3,ts.n1
	camg	t3,o.rang(uot)
	  jrst	ts.nxt
ts.n1:	move	t3,o.rang(uot)
	move	t4,uot
	setzm	f.hit
	jrst	ts.nxt
ts.end:	pop	sp,p4
	pop	sp,p3
	pop	sp,p2
	pop	sp,p1
	movem	t4,uot
	skipl	f.hit
	aos	(sp)
	ret
 
;*****	RNGSCN
 
RNGSCN::
	aoj	uot,
	caile	uot,217
	  ret
	camn	uot,suot
	  jrst	rngscn
	skipge	u.tab(uot)
	  jrst	rngscn
	fixr	ap,o.rang(uot)
	caile	ap,^d2048
	  jrst	rngscn
	aos	(p)
	ret
 
;*****	GETLST
 
GETLST::
	move	t1,c.cnt
	caile	t1,1
	  jrst	gl.er
	skipl	t1,c.nbr1
	caile	t1,4
	  jrst	gl.er
	skipg	t1
	  movei	t1,1
	skipge	uot,luot.a(t1)
	  jrst	[mspini
		 msptyp	<list entry >
		 tro	t1,"0"
		 mspchr	t1
		 msptyp	< is empty>
		 mspout
		 ret]
	push	p,t1
	call	lstxyz
	call	rbecmp
	call	conang
	pop	p,t1
	aos	(p)
	ret
gl.er:	type	<>
	ret
 
;*****	LSTCLR
 
LSTCLR::
	setom	luot.b
	move	ap,[xwd luot.b,luot.b+1]
	blt	ap,luot.b+4
	setz	lst,
	ret
 
;*****	CATALG
 
CATALG::
	caig	uot,7
	  jrst	[move	c,ally.t
		 tdnn	c,u.tab(uot)
		   ret
		 move	c,u.absx(uot)
		 movem	c,u.lstx(uot)
		 move	c,u.absy(uot)
		 movem	c,u.lsty(uot)
		 move	c,u.absz(uot)
		 movem	c,u.lstz(uot)
		 jrst	cat.1]
	move	c,u.tab(uot)
	andi	c,17
	caie	c,7
	cain	c,1
	  ret
cat.1:	move	c,mask.u
	iorm	c,u.tab(uot)
	ret
 
;*****	LSTOUT
 
LSTOUT::
	dspini
	movei	lst,1
	skipl	luot.a(lst)
	  call	lstdsp
	caige	lst,4
	  aoja	lst,.-3
	dspout
	ret
 
;*****	LSTDSP
 
LSTDSP::
	dspini	(lst)
	move	t1,lst
	tro	t1,"0"
	dspchr	t1
	dsptyp	< >
	move	uot,luot.a(lst)
	skipge	t2,u.tab(uot)
	  ret
	hrrz	t2,t2
	andi	t2,7
	cain	t2,2		;test for planet
	  jrst	[hrrz	t3,u.tab(uot)
		 andi	t3,3b31
		 lsh	t3,-4
		 move	t3,p.name(t3)
		 movem	t3,u.name+6
		 jrst	.+1]
	movei	t3,3
	imul	t3,t2
	dspstr	u.name(t3)
	caie	t2,1		;test for star
	cain	t2,7		;test for interceptor
	  jrst	ldsp.1
	dspstr	@o.name(uot)
ldsp.1:	dsppos	^d35
	call	lstxyz
	call	rbecmp
	call	conang
	fixr	t1,b1
	call	nbrfix
	dsptyp	<b >
	fixr	t1,e1
	call	nbrfix
	dsptyp	<e >
	fixr	t1,r1
	caile	t1,^d9999
	  jrst	[idivi	t1,^d1000
		 call	nbrfix
		 dsptyp	<E3r>
		 ret]
	dsptyp	<  >
	call	nbrfix
	dsptyp	<r>
	ret
 
;*****	LSTXYZ
 
LSTXYZ::
	move	c,ally.t
	caig	uot,7
	tdnn	c,u.tab(uot)
	  jrst	lxyz.1
	push	p,u.lstx(uot)
	push	p,u.lsty(uot)
	push	p,u.lstz(uot)
	jrst	lxyz.2
lxyz.1:	push	p,u.absx(uot)
	push	p,u.absy(uot)
	push	p,u.absz(uot)
lxyz.2:	pop	p,z1
	pop	p,y1
	pop	p,x1
	ret
 
;*****	WRPDSP
 
WRPDSP::
	type	<>
	move	t1,s.warp
	tro	t1,"0"
	outchr	t1
	ret
 
;*****	ENETST
 
ENETST::
	camle	t1,u.ener(suot)
	jrst	ene.er
	exch	t1,u.ener(suot)
	subb	t1,u.ener(suot)
	call	enedsp
	aos	(sp)
	ret
ene.er:	sub	t1,u.ener(suot)
	mspini
	msptyp	<insufficient energy, >
	call	fltdsp
	msptyp	< units required>
	mspout
	ret
 
;*****	ENEDSP
 
ENEDSP::
	move	suot,s.uot
	type	<>
	move	t1,u.ener(suot)
	idivi	t1,^d1000
	call	nbrdsp
	type	<8>
	ret
 
;*****	SHLDSP
 
SHLDSP::
	move	suot,s.uot
	type	<>
	skipg	u.shld(suot)
	jrst	[type	<DN >
		 jrst shld.1]
	type	<UP >
shld.1:	movm	t1,u.shld(suot)
	idivi	t1,^d1000
	call	nbrdsp
	type	<8>
	ret
 
;*****	NBRDSP
 
NBRDSP::
	movei	t4," "
	jumpge	t1,.+3
	movei	t4,"-"
	movm	t1,t1
	movei	t3,3
	jrst	.+5
	jumpg	t1,.+4
	push	sp,t4
	movei	t4," "
	jrst	.+4
	idivi	t1,^d10
	tro	t2,"0"
	push	sp,t2
	sojge	t3,.-7
	movei	t3,3
	pop	sp,t2
	outchr	t2
	sojge	t3,.-2
	ret
 
;*****	NBRFIX
 
NBRFIX::

	movei	t4," "
	jumpge	t1,.+3
	movei	t4,"-"
	movm	t1,t1
	movei	t3,3
	jrst	.+5
	jumpg	t1,.+4
	push	sp,t4
	movei	t4," "
	jrst	.+4
	idivi	t1,^d10
	tro	t2,"0"
	push	sp,t2
	sojge	t3,.-7
	movei	t3,3
	pop	sp,t2
	dspchr	t2
	sojge	t3,.-2
	ret
 
;*****	NBROUT
 
NBROUT::
	jumpge	t3,nr.out
	dsptyp	<->
	movm	t3,t3
nr.out:	idivi	t3,^d10
	push	sp,t4
	skipe	t3
	call	nr.out
	pop	sp,t4
	addi	t4,"0"
	dspchr	t4
	ret
 
MSPNBR::
	jumpge	t3,ms.out
	msptyp	<->
	movm	t3,t3
ms.out:	idivi	t3,^d10
	push	sp,t4
	skipe	t3
	call	ms.out
	pop	sp,t4
	addi	t4,"0"
	mspchr	t4
	ret
 
;*****	FLTDSP
 
FLTDSP::
	idivi	t1,^d1000
	push	sp,t2
	setz	t3,
	idivi	t1,^d10
	push	sp,t2
	aoj	t3,
	jumpg	t1,.-3
	pop	sp,t2
	tro	t2,"0"
	mspchr	t2
	sojg	t3,.-3
	msptyp	<.>
	pop	sp,t1
	idivi	t1,^d10
	push	sp,t2
	aoj	t3,
	caige	t3,3
	jrst	.-4
	pop	sp,t2
	tro	t2,"0"
	mspchr	t2
	sojg	t3,.-3
	ret
 
;*****	GETVWR
 
GETVWR::
	move	t1,row
	soj	t1,
	imuli	t1,^d78
	add	t1,col
	adjbp	t1,v.tabp
	ldb	t1,t1
	ret
 
;*****	DSPVWR
 
DSPVWR::
	move	ap,t1
	trze	ap,40
	  type	<>
	hlrz	t2,v.elem(ap)
	skipe	t2
	  outstr  v.mod(t2)
	hrrz	t2,v.elem(ap)
	trne	t2,200
	  jrst	[type	<>
		 outchr	t2
		 type	<>
		 ret]
	outchr	t2
	trze	t1,40
	  type	<>
	ret
 
;*****	RCTEST
 
RCTEST::
	caige	row,2
	ret
	caile	row,^d12
	ret
	caige	col,^d8
	ret
	caig	col,^d74
	aos	(sp)
	ret
 
;*****	TARCLR
 
TARCLR::
	move	row,t.row
	move	col,t.col
	movei	ap,7
	movem	ap,t.row
	movei	ap,^d41
	movem	ap,t.col
	call	tardsp
	ret
 
;*****	STBASE
 
STBASE::
	movei	t1,^d2048
	call	shptst
	  jrst	sb.nsh		;no ship in range
sb.tst:	move	c,u.tab(uot)
	caile	t2,^d1024
	  jrst	[call	sb.st
		 skip
		 movei	t1,^d6000
		 pjrst	tqins]
	tlne	c,1b27
	  jrst	sb.att
	caile	t2,^d512
	  jrst	[tlnn	c,1b26
		   call	detins
		 jrst	sb.hib]
	save	t1,uot
	call	attins
	rest	t1,uot
sb.att:	call	autpha
sb.hib:	movei	t1,^d3000
	pjrst	tqins
 
sb.nsh:	move	c,u.tab(uot)	;no ship in range
	tlz	c,3b27
	movem	c,u.tab(uot)
	call	sb.st
	  ret
	movei	t1,^d6000
	pjrst	tqins
 
sb.st:	move	c,u.ener(uot)
	caml	c,[^d5000K]
	  jrst	sb.et
	addi	c,^d150K
	camle	c,[^d5000K]
	  move	c,[^d5000K]
	movem	c,u.ener(uot)
	aos	(p)
	ret
sb.et:	move	c,u.shld(uot)
	caml	c,[^d5000K]
	  ret
	addi	c,^d150K
	camle	c,[^d5000K]
	  move	c,[^d5000K]
	movem	c,u.shld(uot)
	aos	(p)
	ret
 
;*****	PLANET
;
;	planet routine.  responsible for launching and retrieving interceptors.
;
;	planet uot's are a multiple of 4, ie the last 3 bits are 0.  the
;	planet's three interceptors immediately follow the planet and have
;	uot's equal to the planet uot plus 1, 2, or 3.
;
;	if a planet uot is known, the interceptor uot's are also known.
;	if an interceptor uot is known, the planet's uot can be found by
;	changing the last 3 bits of the interceptor uot to 0.  a number
;	of routines depend on this relationship.
 
PLANET::
	movsi	t1,1b29
	iorm	t1,u.tab(uot)
	movei	t1,^d2048
	call	shptst
	  jrst	pl.nsh		;no ship in range
	move	c,u.tab(uot)
	caile	t2,^d1024
	  jrst	[tlnn	c,1b26
		   call	detins
		 pjrst	pl.reb]
	save	uot
	tlnn	c,1b27
	  call	attins
	rest	uot
	move	t1,u.tab(uot)
	tlne	t1,7
	  jrst	pl.lch
	tlne	t1,70
	  jrst	[movei	t1,^d3000
		 pjrst	tqadd]
	tlz	t1,100
	tlo	t1,7
	movem	t1,u.tab(uot)
	movei	t1,^d15000
	pjrst	tqadd
 
pl.nsh:	move	t1,u.tab(uot)
	tlne	t1,70
	  jrst	pl.get
	tlon	t1,1
	  jrst	pl.nsx
	tlon	t1,2
	  jrst	pl.nsx
	tlon	t1,4
	  jrst	pl.nsx
	tlz	t1,3b27
	movem	t1,u.tab(uot)
	pjrst	pl.reb
pl.nsx:	movem	t1,u.tab(uot)
	movei	t1,^d10000
	pjrst	tqadd
 
pl.get:	move	t2,uot
	movsi	t3,1
	tlze	t1,10
	jrst	pl.gt1
	aoj	t2,
	movsi	t3,2
	tlze	t1,20
	jrst	pl.gt1
	aoj	t2,
	movsi	t3,4
	tlz	t1,40
pl.gt1:	aoj	t2,
	ior	t1,t3
	movem	t1,u.tab(uot)
	move	t3,u.tab(t2)
	tlo	t3,1b18
	movem	t3,u.tab(t2)
	setzm	time.q(t2)
	movei	t1,^d5000
	call	tqadd
	hrlz	t1,mask.a
	hrri	t1,2			;delete object event code
	movem	t1,eadd.a
	movem	t2,eadd.b
	setzm	eadd.t
	pjrst	lqins
 
pl.lch:	move	t2,uot
	movsi	t3,10
	tlze	t1,1
	  jrst	pl.lc1
	aoj	t2,
	movsi	t3,20
	tlze	t1,2
	  jrst	pl.lc1
	aoj	t2,
	movsi	t3,40
	tlz	t1,4
pl.lc1:	aoj	t2,
	ior	t1,t3
	movem	t1,u.tab(uot)
	move	t3,u.tab(t2)
	andi	t1,7b31
	trz	t3,7b31
	ior	t3,t1
	tlz	t3,1b18
	move	t1,ui.e7
	movem	t1,u.ener(t2)
	move	t1,ui.s7
	movem	t1,u.shld(t2)
	movem	t3,u.tab(t2)
	move	uot,t2
	movei	t1,^d500
	call	tqadd
	trz	uot,3
	movei	t1,^d3000
	call	tqadd
	ret
 
pl.reb:
	call	pl.shp
	  jrst	pl.rb2
	getime	t1
	camge	t1,rebel(uot)
	  ret
	movei	c,100
	movem	c,ran.mx
	setzm	ran.mn
	call	random
	trne	t1,1
	  pjrst	rebins
	call	rebtim
	movem	t1,rebel(uot)
pl.rb2:	movei	t1,^d3000
	pjrst	tqins
 
pl.shp:	move	t1,u.tab(uot)
	andi	t1,3b31
	skipn	t1
	  ret
	lsh	t1,-5
	aos	(p)
pl.sh1:	move	t2,u.absx(uot)
	fsbr	t2,u.absx(t1)
	fmpr	t2,t2
	move	c,u.absy(uot)
	fsbr	c,u.absy(t1)
	fmpr	c,c
	fadr	t2,c
	move	c,u.absz(uot)
	fsbr	c,u.absz(t1)
	fmpr	c,c
	fadr	t2,c
	camg	t2,[4000000]		;1024*1024
	  ret
	addi	t1,2
	caig	t1,sh.mx
	  jrst	pl.sh1
	sos	(p)
	ret
 
;*****	INTERC
 
INTERC::
	call	int.mv
	call	int.ta
	ret
 
INT.MV:
	move	t1,uot		;interceptor uot
	move	t2,t1
	trz	t1,3		;form planet uot
	andi	t2,3		;form coordinate key
	move	t3,@[u.absz(t1)
		     u.absx(t1)
		     u.absx(t1)]-1(t2)
	move	t4,@[u.absy(t1)
		     u.absz(t1)
		     u.absy(t1)]-1(t2)
	hlrz	t1,u.tab(uot)
	andi	t1,17
	fadr	t3,a.fact(t1)
	fadr	t4,b.fact(t1)
	movem	t3,@[u.absz(uot)
		     u.absx(uot)
		     u.absx(uot)]-1(t2)
	movem	t4,@[u.absy(uot)
		     u.absz(uot)
		     u.absy(uot)]-1(t2)
	aoj	t1,
	caile	t1,17
	  setz	t1,
	movs	c,u.tab(uot)
	trz	c,17
	ior	c,t1
	movsm	c,u.tab(uot)
	movei	t1,^d2000
	call	tqadd
	hrlz	c,mask.a
	hrri	c,1			;movement event code
	movem	c,eadd.a
	movem	uot,eadd.b
	setzm	eadd.t
	pjrst	lqins
 
INT.TA:
	hlrz	t1,u.tab(uot)
	andi	t1,360
	lsh	t1,-4
	cail	t1,6
	  seto	t1,
	aoj	t1,
	lsh	t1,4
	movs	t2,u.tab(uot)
	trz	t2,360
	ior	t2,t1
	movsm	t2,u.tab(uot)
	trne	t1,360
	  ret
	movei	t1,^d1024
	call	shptst
	  ret		;no ship in range
	call	autpha
	ret
 
;*****	DETINS
 
DETINS::
	move	c,u.tab(uot)
	tlo	c,1b26
	movem	c,u.tab(uot)
	trnn	c,3b31
	  ret
	trne	c,1b31
	  jrst	[hrrz	c,mask.f
		 jrst	.+2]
	hrrz	c,mask.k
	ior	c,uot
	hrli	c,11
	movsm	c,eadd.a
	hrrzm	t1,eadd.b
	setzm	eadd.t
	pjrst	lqins
 
;*****	ATTINS
 
ATTINS::
	move	c,u.tab(uot)
	tlo	c,3b27
	movem	c,u.tab(uot)
	trnn	c,3b31
	  ret
	trne	c,1b31
	  jrst	[hrrz	c,mask.f
		 jrst	.+2]
	hrrz	c,mask.k
	tro	c,1b27
	ior	c,uot
	hrli	c,11
	movsm	c,eadd.a
	hrrzm	t1,eadd.b
	setzm	eadd.t
	pjrst	lqins
 
REBTIM::
	getime	t1
	addi	t1,^d10000
	move	t2,u.tab(uot)
	andi	t2,3b31
	movei	t3,pl.mx
rtim1:	skipge	c,u.tab(t3)
	  jrst	rtim2
	andi	c,3b31
	came	c,t2
	  jrst	rtim2
	move	c,u.tab(t3)
	andi	c,17
	cain	c,2
	  jrst	[addi	t1,^d10000
		 jrst	rtim2]
	caie	c,3
	cain	c,4
	  addi	t1,^d30000
rtim2:	soj	t3,
	cail	t3,sb.mn
	  jrst	rtim1
	ret
 
REBINS::
	move	c,u.tab(uot)
	trne	c,1b31
	  jrst	[hrrz	c,mask.f
		 jrst	.+2]
	hrrz	c,mask.k
	hrli	c,13
	movsm	c,eadd.a
	hrrzm	uot,eadd.b
	setzm	eadd.t
	move	c,u.tab(uot)
	trz	c,3b31
	tro	c,1b29
	movem	c,u.tab(uot)
	pjrst	lqins
 
;*****	SHPTST
;
;	Test for nearest ship within a given range of an object.  T1 = test
;	range.  UOT = object uot.  Non-skip return and T1 < 0 if no ship
;	is in range.  Skip return and T1 = ship uot if a ship is in range.
;	Range is in T2.  If object is neutral all ships are tested,
;	otherwise only enemy ships are tested.
 
SHPTST::
	imul	t1,t1		;square the distance
	fltr	t4,t1		;t4 is the distance to beat
	hrrz	c,u.tab(uot)	;get the uot's u.tab word
	andi	c,3b31		;mask everything but the alliance field
	skipe	c		;zero means neutral
	  trc	c,3b31		;the complement is the enemy
	movem	c,s.mask	;save either neutral (0) or enemy mask
	movei	t1,117		;test ships and interceptors
	setom	f.uot		;temp storage if any ship passes the tests
spt.lp:	came	t1,uot	
	skipge	t2,u.tab(t1)	;active ship?
	  jrst	spt.nx		;no - skip it
	trnn	t2,3b31		;neutral?
	  jrst	spt.nx		;yes - skip it
	move	c,t2		;going to look for a ship or an interceptor
	andi	c,17
	cail	c,3		;ship uids are 5 and 6
	caile	c,7		;interceptor uid is 7
	  jrst	spt.nx		;neither a ship nor an interceptor
	skipe	s.mask			;if the mask isn't zero,
	  jrst	[xor	t2,s.mask	;xor it with u.tab word;
		 trne	t2,3b31		;if zero, the ship is an enemy,
		 jrst	spt.nx		;if not zero, it's a friend
		 jrst	spt.rn]		;it's an enemy
spt.rn:	move	t3,u.absx(uot)	;compute range ** 2 = (x1 - x2) ** 2
	fsbr	t3,u.absx(t1)
	fmpr	t3,t3		;if any intermediate square is greater than
	camle	t3,t4		;  the squared least distance
	  jrst	spt.nx		;  the ship is not nearest or is out of range.
	move	c,u.absy(uot)
	fsbr	c,u.absy(t1)
	fmpr	c,c
	camle	c,t4		;test the y distance
	  jrst	spt.nx
	fadr	t3,c
	move	c,u.absz(uot)
	fsbr	c,u.absz(t1)
	fmpr	c,c
	camle	c,t4		;test the z distance
	  jrst	spt.nx
	fadr	t3,c
	camle	t3,t4		;test the total distance
	  jrst	spt.nx		;ship is not closest or is out of range
	movem	t3,t4		;store the new least distance
	movem	t1,f.uot	;save the ship's uot
spt.nx:	sojge	t1,spt.lp
	skipge	t1,f.uot	;f.uot < 0 means no target found.
	  ret
	movem	t4,f.data
	movei	c,f.loc
	save	t1
	call	sqrt.##
	fixr	t2,rs
	rest	t1
	aos	(p)
	ret
 
;*****	FLSHLD
 
FLSHLD::
	save	p1,p2
	move	p1,flsh.p
	setz	t4,
	call	flins
fll.1:	skipn	p2,(p1)
	  jrst	fll.2
	hlrz	p2,p2
	trze	p2,1b18
	  aoja	row,.+3
	trze	p2,1b19
	  soj	row,
	sub	col,p2
	hrrz	p2,(p1)
	call	flins
	sojg	p2,.-1
	aoja	p1,fll.1
fll.2:	setzm	flsh.t(t4)
	rest	p1,p2
	ret
 
flins:	call	rctest
	  jrst	fli.1
	call	getvwr
	move	t3,col
	lsh	t3,^d9
	ior	t3,row
	hrl	t3,t1
	movem	t3,flsh.t(t4)
	aoj	t4,
fli.1:	aoj	col,
	ret
 
;*****	FLSHBR
 
FLSHBR::
	save	p1
	setzb	p1,v.row
flb.1:	skipn	row,flsh.t(p1)
	  jrst	flb.2
	move	col,row
	lsh	col,-^d9
	andi	row,777
	andi	col,777
	call	vnextp
	type	< >
	aoja	p1,flb.1
flb.2:	rest	p1
	ret
 
;*****	FLSHCH
 
FLSHCH::
	save	p1
	setzb	p1,v.row
flc.1:	skipn	row,flsh.t(p1)
	  jrst	flc.2
	hlrz	t1,row
	move	col,row
	lsh	col,-^d9
	andi	row,777
	andi	col,777
	call	vnextp
	call	dspvwr
	aoja	p1,flc.1
flc.2:	rest	p1
	ret
 
;*****	TRWAIT
 
TRWAIT::
	type	<>
	getime	ap
	add	ap,t1
	movem	ap,t.time
tr.wt:
ife tops20,<
	seto	ap,
	wake	ap,
	skip
	hrrzi	ap,^d250
	hiber	ap,
	skip
	hrrzi	ap,^d250
	hiber	ap,
	skip
>
ifn tops20,<
	movei	t1,^d250
	disms
>
	call	qtest
	getime	ap
	camge	ap,t.time
	jrst	tr.wt
	type	<>
	ret
 
;*****	PHAHIT
 
PHAHIT::
	skipg	o.relx(uot)
	  ret
	fix	t1,o.rang(uot)
	caile	t1,^d512
	  ret
	save	t1
	call	conuot
	call	conurc
	rest	t1
	movei	c,flsh05
	movem	c,flsh.p
	call	flshld
	type	<(B>
	call	flshbr
	type	<>
	call	flshch
	type	<8>
	ret
 
;*****	PHOHIT
 
PHOHIT::
	skipg	o.relx(uot)
	  ret
	fix	t1,o.rang(uot)
	caile	t1,^d1792
	  ret
	save	t1
	call	conuot
	call	conurc
	rest	t1
	movei	c,flsh11
	caile	t1,^d512
	  movei	c,flsh05
	caile	t1,^d768
	  movei	c,flsh01
	movem	c,flsh.p
	call	flshld
	type	<(B>
	call	flshbr
	type	<>
	call	flshch
	type	<8>
	ret
 
;*****	EXPLOD
 
EXPLOD::
	skipg	o.relx(uot)
	  ret
	fixr	t1,o.rang(uot)
	caile	t1,^d2048
	  ret
	save	t1,uot
	call	scndel
	skipe	row,row.1
	  jrst	[camn	row,t.row
		 call	tarupd
		 move	row,row.1
		 setom	v.flag
		 call	vwrchg
		 jrst	.+1]
	rest	uot
	call	conuot
	call	conurc
	rest	t1
	idivi	t1,^d512
	cail	t1,7
	  ret
	hrrz	c,u.tab(uot)
	andi	c,17
	cain	c,7
	  addi	t1,4
	movei	c,@[flsh24		;everything but interceptors
		  flsh24
		  flsh16
		  flsh11
		  flsh16		;interceptors
		  flsh16
		  flsh11
		  flsh05](t1)
	movem	c,flsh.p
	call	flshld
	type	<(1>
	call	flshbr
	type	<(B8>
	call	flshch
	type	<8>
	ret
 
;****	ZAPPED
 
ZAPPED::
	movsi	c,1b18
	iorm	c,u.tab(suot)
	move	uot,suot
	andi	uot,1
	setz	c,
zap.1:	skipl	u.tab(uot)
	  aoj	c,
	addi	uot,2
	caig	uot,sh.mx
	  jrst	zap.1
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<>
	type	<(B>
	movei	t1,[asciz /#3/]
	skipn	c
	  movei	t1,[asciz /#3/]
	outstr	(t1)
	outstr	@o.name(suot)
	type	< Destroyed!>
	movei	t2,[asciz /#4/]
	skipn	c
	  movei	t2,[asciz /#4/]
	outstr	(t2)
	outstr	@o.name(suot)
	type	< Destroyed!>
	skipn	c
	  jrst	[movei	t1,[asciz /FEDERATION/]
		 movei	t2,[asciz /KLINGON EMPIRE/]
		 trne	uot,1
		   exch	t1,t2
		 type	<#3>
		 outstr	(t1)
		 type	< Defeated!>
		 type	<#4>
		 outstr	(t1)
		 type	< Defeated!>
		 type	<#3>
		 outstr	(t2)
		 type	< Victorious!>
		 type	<#4>
		 outstr	(t2)
		 type	< Victorious!>
		 jrst	.+1]
	type	<>
ife tops20,<
	seto	t2
	trmno.	t2,
	  skip
	move	c,[xwd 2,t1]
	movei	t1,2
	trmop.	c,
	  skipa
	jrst	.-2
>
ifn tops20,<
	movei t1,.cttrm
	dobe
>
	call	stwait
	call	wrapup
	gexit
 
;*****	ENETRN
 
ENETRN::
	call	enedsp
	call	shldsp
	mspini
	msptyp	<transfer complete>
	mspout
	ret
 
;*****	DSPMSG
 
DSPMSG::
	imuli	uot,^d11
	type	<>
	mspini
	mspstr	u.msg(uot)
	mspout
	ret
 
DSPNAM::
	move	ap,u.tab(uot)
	andi	ap,7
	jrst	@[dnm.st
		  dnm.rs
		  dnm.bs
		  dnm.bs
		  dnm.rs
		  dnm.rs
		  dnm.in]-1(ap)
dnm.st:	dsptyp	<Star>
	ret
dnm.in:	dsptyp	<Interceptor>
	ret
dnm.bs:	dsptyp	<Starbase >
dnm.rs:	dspstr	@o.name(uot)
	ret 
 
MSPNAM::
	move	ap,u.tab(uot)
	andi	ap,7
	jrst	@[mnm.st
		  mnm.rs
		  mnm.bs
		  mnm.bs
		  mnm.rs
		  mnm.rs
		  mnm.in]-1(ap)
mnm.st:	msptyp	<Star>
	ret
mnm.in:	msptyp	<Interceptor>
	ret
mnm.bs:	msptyp	<Starbase >
mnm.rs:	mspstr	@o.name(uot)
	ret 
 
;*****	AUTPHA, AUTPHO
;
;	weapons fire from a base, interceptor, or unmanned ship.  UOT is
;	uot of firing entity.  T1 is uot of receiving entity.  uses A.FIRE
;	work area.  AUTPHA fires 200 units phaser, AUTPHO fires 1 torpedo.
 
AUTPHA::
	movei	c,^d200
	movem	c,a.fire
	pjrst	authit
AUTPHO::
	movsi	c,1b27
	hrri	c,^d200
	movem	c,a.fire
	pjrst	authit
 
AUTHIT::
	hlrz	c,a.fire
	ior	c,mask.a
	hrli	c,4
	movsm	c,eadd.a
	movem	uot,eadd.b
	setzm	eadd.t
	save	t1
	call	lqins
	rest	t1
	movei	c,2000
	move	t2,u.tab(t1)
	caig	t1,7
	tlnn	t2,1b19
	  jrst	[lsh	c,@suot
		 jrst	.+2]
	lsh	c,@t1
	ior	c,uot
	hrli	c,5			;hit request event code
	movsm	c,eadd.a
	hllz	c,a.fire
	iorm	c,eadd.a
	hrlz	c,a.fire
	hrr	c,t1
	movem	c,eadd.b
	movei	c,^d750
	movem	c,eadd.t
	move	c,u.absx(t1)
	movem	c,eadd.x
	move	c,u.absy(t1)
	movem	c,eadd.y
	move	c,u.absz(t1)
	movem	c,eadd.z
	pjrst	lqins
 
;*****	ENEADD
 
ENEADD::
	imuli	t1,^d1000
	skipg	c,u.shld(uot)
	  jrst	eda.2
	sub	c,t1
	jumpl	c,eda.1
	  caig	c,^d100000
	  movn	c,c		;shields down
	  movem	c,u.shld(uot)
	  ret
eda.1:	movn	t1,c
	setzb	c,u.shld(uot)
eda.2:	add	t1,u.ener(uot)
	sub	t1,c		;c is < 0 - this is an add
	camle	t1,[^d5000000]
	  move	t1,[^d5000000]
	add	t1,c		;c is < 0 - this is a subtract
	movem	t1,u.ener(uot)
	ret
 
;*****	ENEDEL
 
ENEDEL::
	imuli	t1,^d1000
	skipge	ap,u.shld(uot)
	  jrst	edl.1
	sub	ap,t1
	jumpl	ap,edl.2
	  caig	ap,^d100000
	  movn	ap,ap
	  movem	ap,u.shld(uot)
	  ret
edl.1:	movm	ap,u.shld(uot)
	add	t1,t1
	sub	ap,t1
	jumpl	ap,edl.3
	  movnm	ap,u.shld(uot)
	  ret
edl.2:	add	ap,ap
edl.3:	movm	t1,ap
	setzm	u.shld(uot)
	exch	t1,u.ener(uot)
	subm	t1,u.ener(uot)
	ret
 
;*****	PHRSET
 
PHRSET::
	call	dstroy
	setom	t.uot
	setzm	t.bear
	setzm	t.elev
	call	contrc
	call	tardsp
	ret
 
;*****	DSTROY
 
DSTROY::
	move	t1,u.tab(uot)
	tlo	t1,1b18
	movem	t1,u.tab(uot)
	andi	t1,7
	cain	t1,7
	  jrst	[move	t2,uot
		 andi	t2,3
		 movsi	t1,4
		 lsh	t1,@t2
		 move	t2,uot
		 trz	t2,3
		 andcam	t1,u.tab(t2)
		 jrst	.+1]
	cail	uot,7

	caile	uot,120
	  ret
	setzm	time.q(uot)
	ret
 
;*****	SCANSR
 
SCANSR::
	setz	t2,
	skipn	scan.1(t2)
	ret
	hlrz	t3,scan.1(t2)
	lsh	t3,-^d9
	came	t3,uot
	aoja	t2,.-5
	hrrz	row,scan.1(t2)
	move	col,row
	trz	row,-1000
	lsh	col,-^d9
	aos	(sp)
	ret
 
;*****	GETMSG
 
GETMSG::
	move	t1,m.ptr
	movem	t1,m.wptr
	move	t2,[ascii/     /]
	movsi	t1,-^d10
	movem	t2,m.msg(t1)
	aobjn	t1,.-1
	move	t2,[asciz/   /]
	movem	t2,m.msg(t1)
	move	uot,s.uot
	move	t2,[point 7,o.init(uot)]
	ildb	t2,t2
	idpb	t2,m.wptr
	movei	t2,":"
	idpb	t2,m.wptr
	movei	t2," "
	idpb	t2,m.wptr
	call	gm.out
gm.nxt:	type	<7>
	push	sp,ap
	call	vtget
	pop	sp,ap
	skipe	t1,c.inte
	jrst	gm.spe
	cail	ap,^d53
	jrst	gm.err
	aoj	ap,
	move	t2,c.char
	idpb	t2,m.wptr
	outchr	t2
	jrst	gm.nxt
gm.spe:	cain	t1,^d13
	jrst	gm.exe
	cain	t1,^d21
	jrst	gm.ctu
	cain	t1,^d127
	jrst	gm.del
	cain	t1,^d8
	jrst	gm.del
	caie	t1,""
	jrst	gm.err
	move	t2,c.char
	cain	t2,","
	jrst	gm.era
gm.err:	type	<>
	jrst	gm.nxt
gm.del:	caig	ap,3
	jrst	gm.err
	movei	t2," "
	dpb	t2,m.wptr
	type	< >
	soj	ap,
	move	t1,ap
	adjbp	t1,m.ptr
	movem	t1,m.wptr
	jrst	gm.nxt
gm.ctu:	push	sp,ap
	movei	ap,3
	move	t1,ap
	adjbp	t1,m.ptr
	movem	t1,m.wptr
	call	gm.spc
	pop	sp,ap
	adjbp	ap,m.ptr
	setz	t2,
	idpb	t2,ap
	call	gm.out
	move	t1,ap
	adjbp	t1,m.ptr
	movem	t1,m.wptr
	jrst	gm.nxt
gm.era:	move	row,m.row
	movei	col,5
	call	vtpos
	outstr	spc.55
	jrst	.+5
gm.exe:	cain	ap,3
	jrst	gm.nxt
	call	gm.spc
	aos	(sp)
	type	<7>
	move	ap,[xwd m.msg,utxt.a+41]
	blt	ap,utxt.a+53
	move	ap,[xwd m.msg,utxt.b+41]
	blt	ap,utxt.b+53
	ret
 
gm.out:	move	row,m.row
	movei	col,6
	call	vtpos
	outstr	m.msg
	movei	col,^d9
	call	vtpos
	movei	ap,3
	ret
 
gm.spc:	movei	t2," "
	cail	ap,^d53
	jrst	.+4
	aoj	ap,
	idpb	t2,m.wptr
	jrst	.-4
	setz	t2,
	idpb	t2,m.wptr
	ret
 
;*****	TQINS
;
;	Activate a time.q entry if not already activated
 
TQINS::
	skipg	time.q(uot)
	pjrst	tqadd
	ret
 
;*****	TQADD
 
TQADD::
	getime	c
	add	t1,c
	movem	t1,time.q(uot)
	skipe	c,q.time
	caml	c,t1
	movem	t1,q.time
	ret
 
;*****	QTEST
 
QTEST::
	push	p,uot			;save uot
	getime	c
	movem	c,m.time
	call	eqtest
	skipe	q.time
	  jrst	[move	ap,[xwd eadd.a,ewrk.a]
		 blt	ap,ewrk.z
		 call	tqtest
		 move	ap,[xwd ewrk.a,eadd.a]
		 blt	ap,eadd.z
		 jrst	.+1]
	pop	p,uot
	ret
 
;*****	TQTEST
 
TQTEST::
	move	t1,m.time
	camg	t1,q.time
	  ret
	setzm	q.time
	movei	uot,pl.mx+1
tqt.1:	sojl	uot,r
	skipg	t1,time.q(uot)
	  jrst	tqt.1
	camge	t1,m.time
	  jrst	[setzm	time.q(uot)
		 push	p,uot
		 call	tqexec
		 pop	p,uot
		 jrst	tqt.1]
	skipe	ap,q.time
	caml	ap,t1
	  movem	t1,q.time
	jrst	tqt.1
 
;*****	TQEXEC
 
TQEXEC::
	move	c,u.tab(uot)
	andi	c,17
	pjrst	@[planet
		  stbase
		  stbase
		  stship
		  stship
		  interc]-2(c)
	ret
 
;*****	HQADD
 
HQADD::
	call	qtest
	pjrst	hqins
 
;*****	LQADD
 
LQADD::
	call	qtest
	pjrst	lqins
 
;*****	HQINS
 
HQINS::
	movei	p1,hq.min
	movei	p2,hq.max
	save	uot
	call	eqins
	rest	uot
	ret
 
;*****	LQINS
 
LQINS::
	movei	p1,lq.min
	movei	p2,lq.max
	save	uot
	call	eqins
	rest	uot
	ret
 
;*****	EQINS
 
EQINS::
	move	c,mask.q
	andb	c,eadd.a
	tlnn	c,@mask.a
	  ret
eqi.1:	move	p3,p1
	seto	c,
eqi.2:	exch	c,evnt.t(p3)
	skipn	c
	  jrst	[movei	c,evnt.a(p3)
		 hrli	c,eadd.a
		 blt	c,evnt.z(p3)
		 aos	c,m.time
		 add	c,eadd.t
		 movem	c,evnt.t(p3)
		 ret]
	skipge	evnt.t(p3)
	  exch	c,evnt.t(p3)
	addi	p3,6
	camg	p3,p2
	  jrst	eqi.2
	save	p1,p2
	getime	c
	movem	c,m.time
	call	eqtest
	rest	p1,p2
	jrst	eqi.1
 
;*****	EQTEST
 
EQTEST::
	movei	p1,hq.min
	movei	p2,hq.max
	call	eqscan
	movei	p1,lq.min
	movei	p2,lq.max
	call	eqscan
	ret
 
;*****	EQSCAN
 
EQSCAN::
	setz	p3,
eqs.1:	skiple	c,evnt.t(p1)
	camle	c,m.time
	  jrst	eqs.2
	move	c,evnt.a(p1)
	tlnn	c,@mask.c
	  jrst	eqs.2
	movem	p1,work.q(p3)
	aoj	p3,
eqs.2:	addi	p1,6
	camg	p1,p2
	  jrst	eqs.1
eqs.3:	move	t1,p3
	move	t2,m.time
	aoj	t2,
	seto	t3,
eqs.4:	sojl	t1,eqs.5
	skipge	c,work.q(t1)
	  jrst	eqs.4
	camg	t2,evnt.t(c)
	  jrst	eqs.4
	move	t3,t1
	move	t2,evnt.t(c)
	jrst	eqs.4
eqs.5:	skipge	t3
	  ret
	move	p1,work.q(t3)
	setom	work.q(t3)
	call	eqexec
	movs	c,mask.c
	andcab	c,evnt.a(p1)
	tlnn	c,@mask.a
	  setzm	evnt.t(p1)
	jrst	eqs.3
 
;*****	EQEXEC
 
EQEXEC::
	hrrz	uot,evnt.b(p1)		;get the uot of the 'object' ship.
	hrrz	t1,evnt.a(p1)		;get the event code.
	andi	t1,77			;mask the event code fields.
	caie	t1,0			;return if zero.
	pjrst	@[movobj		;movement.
		  delobj		;delete an object.
		  dspmsg		;display ship-ship msg.
		  hitdsp		;display a hit.
		  hitreq		;process a hit.
		  hitack		;acknowledge a hit.
		  hitdst		;hit caused an object's destruction.
		  enetrn		;transfer energy.
		  detmsg		;notify detected or attacking.
		  dalert		;notify needs assistance.
		  rebmsg]-1(t1)		;notify planet has rebelled.
	ret				;none of the above.
 
;*****	MOVOBJ
 
MOVOBJ::
	skipge	u.tab(uot)
	  ret
	call	rbelod
	camn	uot,t.uot
	  call	tarupd
	call	scndel
	call	scntst
	pjrst	vwrtst
 
;*****	DELOBJ
 
DELOBJ::
;;	skipge	u.tab(uot)
;;	  ret
	call	scndel
	setzm	row.2
	pjrst	vwrtst
 
;*****	HITDSP
 
HITDSP::
	fix	ap,o.rang(uot)
	caile	ap,^d2048
	  ret
	call	scansr
	  ret
	move	t2,ap
	move	ap,evnt.a(p1)
	tlnn	ap,1b27
	  pjrst	phadsp
	pjrst	phodsp
 
phadsp:	caig	t2,^d1024
	call	rctest
	  ret
	call	vtpos
	type	<>
	movei	t1,^d10
	type	<(B (B>
	sojg	t1,.-1
	type	<>
	call	getvwr
	call	dspvwr
	type	<(B>
	type	<8>
	ret
 
phodsp:	movei	c,flsh03
	caile	t2,^d512
	  movei	c,flsh01
	movem	c,flsh.p
	call	flshld
	type	<B>
	call	flshbr
	type	<>
	call	flshch
	type	<8>
	ret
 
;*****	HITREQ
;
;	Initiated by the PHASER, PHOTON, or AUTHIT routines.  Determines
;	whether an object has been hit.  Two cases are handled:
;
;	1:  Something hits us (uot = suot).
;	2:  We hit a non-ship (uot not = suot).
;
;	In both cases, only one ship processes a hit request (and therefore
;	has exclusive control of the evnt data).  Depending upon the outcome
;	of this routine, the hit request is changed to a hit acknowledge
;	(HITACK) or a hit destroy (HITDST), and the evnt.a ship mask is
;	changed so that other ships can process it.
 
HITREQ::
	movei	ap,6			;hit acknowledge event code
	hrrm	ap,evnt.a(p1)
	came	uot,suot
	  jrst	hr.oth
hr.us:	hlrz	ap,evnt.a(p1)
	andi	ap,377
	skipge	u.tab(ap)
	  ret
	call	hittst
	  ret
	hlrz	t1,evnt.b(p1)
	call	enedel
	call	hitus
	movm	ap,u.shld(uot)
	add	ap,u.ener(uot)
	skipl	ap
	  jrst	[call	hitmsg
		 pjrst	hitchg]
	aos	evnt.a(p1)
	call	hitchg
	jrst	zapped
 
hr.oth:	skipge	u.tab(uot)
	  ret
	hlrz	t1,evnt.b(p1)
	call	enedel
	movm	ap,u.shld(uot)
	add	ap,u.ener(uot)
	skipl	ap
	  jrst	[call	attack
		 call	hitack
		 pjrst	hitchg]
	call	dstroy
	hlrz	ap,evnt.a(p1)
	andi	ap,377
	camn	ap,suot
	  jrst	[setom	t.uot
		 setzm	t.bear
		 setzm	t.elev
		 call	contrc
		 call	tardsp
		 jrst	.+1]
	call	hitdst
	aos	evnt.a(p1)
	pjrst	hitchg
 
HITCHG::
	move	c,evnt.a(p1)
	tlo	c,@mask.a
	and	c,mask.q
	tlz	c,@mask.c
	tlne	c,@mask.a
	  movem	c,evnt.a(p1)
	ret
 
ATTACK::
	hrrz	c,u.tab(uot)
	andi	c,17
	caie	c,7
	cain	c,2
	  jrst	att.pl
	caie	c,3
	cain	c,4
	  jrst	[call	att.ms
		 jrst	att.ex]
	ret
att.pl:	save	uot
	trz	uot,3
	call	att.ms
	hlrz	c,evnt.a(p1)
	andi	c,377
	move	c,u.tab(c)
	trnn	c,3b31
	  jrst	[rest	uot
		 jrst	att.ex]
	andi	c,3b31
	trc	c,3b31
	movem	c,s.mask
att.p1:	move	c,u.tab(uot)
	trz	c,3b31
	ior	c,s.mask
	movem	c,u.tab(uot)
	aoj	uot,
	trne	uot,3
	  jrst	att.p1
	rest	uot
att.ex:	movei	t1,^d2000
	call	tqins
	ret
 
att.ms:	movei	c,1b18
	move	t1,u.tab(uot)
	tlon	t1,3b28
	  iorm	c,evnt.a(p1)
	movem	t1,u.tab(uot)
	ret
 
HITTST::
	move	t1,u.absx(uot)
	fsbr	t1,evnt.x(p1)
	fmpr	t1,t1
	camle	t1,[4096.0]
	  ret
	move	c,u.absy(uot)
	fsbr	c,evnt.y(p1)
	fmpr	c,c
	fadrm	c,t1
	camle	t1,[4096.0]
	  ret
	move	c,u.absz(uot)
	fsbr	c,evnt.z(p1)
	fmpr	c,c
	fadrm	ap,t1
	camg	t1,[4096.0]
	  aos	(p)
	ret
 
HITUS::
	type	<>
	type	<[?5h[?5l>
	type	<[?5h[?5l>
	type	<[?5h[?5l>
	type	<[?5h[?5l>
	type	<[?5h[?5l>
	call	enedsp
	call	shldsp
	ret
 
HITMSG::
	mspini
	hlrz	t3,evnt.b(p1)
	call	mspnbr
	msptyp	< unit hit by >
	hlrz	t1,evnt.a(p1)
	trnn	t1,1b27
	  jrst	[msptyp	<phasers>
		 jrst	.+2]
	msptyp	<photon torpedo>
	mspout
	ret
 
;*****	HITACK
 
HITACK::
	hlrz	c,evnt.a(p1)
	trne	c,1b27
	  jrst	[call	phohit
		 jrst	.+2]
	call	phahit
	call	attmsg
	ret
 
;*****	HITDST
 
HITDST::
	call	explod
	call	dstmsg
	ret
 
ATTMSG::
	move	c,evnt.a(p1)
	trnn	c,1b18
	  ret
	move	c,ally.u
	tdnn	c,u.tab(uot)
	  ret
	mspini
	save	uot
	hlrz	uot,evnt.a(p1)
	andi	uot,377
	call	mspnam
	msptyp	< attacking >
	rest	uot
	call	mspnam
	mspout
	ret
 
DSTMSG::
	hrrz	c,u.tab(uot)
	andi	c,17
	cain	c,7
	  ret
	mspini
	call	mspnam
	msptyp	< destroyed>
	mspout
	ret
 
DETMSG::
	mspini
	move	c,evnt.a(p1)
	tlne	c,1b27
	  jrst	det.a
det.d:	call	mspnam
	msptyp	< detected by >
	save	uot
	hlrz	uot,evnt.a(p1)
	andi	uot,377
	call	mspnam
	rest	uot
	mspout
	ret
det.a:	save	uot
	hlrz	uot,evnt.a(p1)
	andi	uot,377
	call	mspnam
	rest	uot
	msptyp	< attacking >
	call	mspnam
	mspout
	ret
 
REBMSG::
	mspini
	msptyp	<rebellion on >
	mspstr	@o.name(uot)
	mspout
	ret
 
;*****	DALERT
 
DALERT::
	mspini
	mspstr	@o.name(uot)
	hlrz	c,evnt.b(p1)
	xct	[msptyp	< needs assistance>
		 msptyp < on RED ALERT>
		 msptyp < on YELLOW ALERT>
		 msptyp < secure from alert>](c)
	mspout
	ret


 
;*****	STSHIP
;
;	these routines control the activities of unmanned ships.  ship
;	behavior is governed by a set of 'missions'.
 
STSHIP::
	call	asetup
	call	nrload
	hrrz	t4,n.mssn(uot)
	jrst	@[stsh.0
		  stsh.1
		  stsh.2
		  stsh.2
		  stsh.2
		  stsh.2](t4)
stsh.0:	call	ai.ref
	  ret
	jrst	stsh.3
stsh.1:	call	ac.ref
	  ret
	jrst	stsh.3
stsh.2:	call	ai.ref
	  ret
	call	@[ac.esh
		  ac.eba
		  ac.cap
		  ac.hlp]-2(t4)
	  ret
stsh.3:	call	ai.esh
	  ret
	call	ai.hlp
	  ret
	call	ai.eba
	  ret
	call	ai.cap
	  ret
	pjrst	au.sea
 
;*****	ASETUP
;
;	sets up us-them masks for this ship.
 
ASETUP::
	movei	c,1
	dmove	t1,mask.f
	tdne	c,uot
	  exch	t1,t2
	dmovem	t1,mska.u
	dmove	t1,ally.f
	tdne	c,uot
	  exch	t1,t2
	dmovem	t1,alya.u
	movm	c,u.shld(uot)
	add	c,u.ener(uot)
	movem	c,n.ener
	movei	t1,^d50
	pjrst	salloc
 
;*****	NRLOAD
;
;	builds a table of ranges from this ship for all non-star objects.
;	saves the uot and range of the nearest object of a class (planet,
;	fed base, kli base, etc) and of the nearest neu, fed, and kli
;	planet.  also catalogs objects within 1024 units (short range
;	scan function).
 
NRLOAD::
	save	p1,p2,p3
	setom	n.rang
	move	c,[xwd n.rang,n.rang+1]
	blt	c,n.rang+117
	setom	n.nuot
	move	c,[xwd n.nuot,n.nuot+1]
	blt	c,n.nuot+7
	seto	c,
	tlz	c,1b18
	movem	c,n.nran
	move	c,[xwd n.nran,n.nran+1]
	blt	c,n.nran+7
	setzm	n.pcnt
	setzm	n.scnt
	move	t1,u.absx(uot)
	move	t2,u.absy(uot)
	move	t3,u.absz(uot)
	movei	t4,117
nrl.1:	skipl	p2,u.tab(t4)
	camn	t4,uot
	  jrst	nrl.3
	move	p1,t1
	fsbr	p1,u.absx(t4)
	fmpr	p1,p1
	movem	p1,f.data
	move	p1,t2
	fsbr	p1,u.absy(t4)
	fmpr	p1,p1
	fadrm	p1,f.data
	move	p1,t3
	fsbr	p1,u.absz(t4)
	fmpr	p1,p1
	fadrm	p1,f.data
	movei	c,f.loc
	save	t1
	call	sqrt.##
	rest	t1
	fixr	rs,rs
	movem	rs,n.rang(t4)
	andi	p2,17
	caig	rs,^d1024
	  call	ncatal
	caie	p2,2
	  jrst	nrl.2
	move	p2,u.tab(t4)
	trne	p2,@alya.u
	  aos	n.pcnt
	trnn	p2,@mska.u
	  jrst	nrl.3
	andi	p2,3b31
	lsh	p2,-4
nrl.2:	caml	rs,n.nran(p2)
	  jrst	nrl.3
	movem	rs,n.nran(p2)
	movem	t4,n.nuot(p2)
nrl.3:	sojge	t4,nrl.1
	move	c,uot
	trne	c,1
	  call	nrswap
	rest	p1,p2,p3
	ret
 
;*****	NCATAL
;
;	the short range scan catalog routine.
 
NCATAL::
	caig	t4,7
	  jrst	[move	c,alya.t
		 tdnn	c,u.tab(t4)
		   ret
		 aos	n.scnt
		 move	c,u.absx(t4)
		 movem	c,u.lstx(t4)
		 move	c,u.absy(t4)
		 movem	c,u.lsty(t4)
		 move	c,u.absz(t4)
		 movem	c,u.lstz(t4)
		 jrst	ncat.1]
	caie	p2,7
	cain	p2,1
	  ret
	skipg	time.q(t4)
	  call	nqins
ncat.1:	move	c,mska.u
	iorm	c,u.tab(t4)
	ret
 
;*****	NQINS
 
NQINS::
	move	c,ally.n
	tdne	c,u.tab(t4)
	  ret
	getime	c
	movem	c,time.q(t4)
	skipe	q.time
	camge	c,q.time
	  movem	c,q.time
	ret
 
;*****	NRSWAP
;
;	swaps uots and ranges of near bases and ships.
 
NRSWAP::
	dmove	t1,nrpl.u
	exch	t1,t2
	dmovem	t1,nrpl.u
	dmove	t1,nrsb.u
	exch	t1,t2
	dmovem	t1,nrsb.u
	dmove	t1,nrsh.u
	exch	t1,t2
	dmovem	t1,nrsh.u
	dmove	t1,nupl.u
	exch	t1,t2
	dmovem	t1,nupl.u
	dmove	t1,nusb.u
	exch	t1,t2
	dmovem	t1,nusb.u
	dmove	t1,nush.u
	exch	t1,t2
	dmovem	t1,nush.u
	ret
 
;*****	AU.SEA, MISSION 0
;
;	the basic mission, performed when no other mission applies.
;	a tour at warp 7 of all bases and friendly planets.  refuels
;	at each stop.
 
AU.SEA::
	setzm	n.mssn(uot)
	skipg	t1,n.muot(uot)
	  jrst	au.se1
	skipl	c,u.tab(t1)
	trnn	c,@alya.u
	  jrst	au.se1
	jrst	au.se2
au.se1:	call	aubase
	  jrst	au.se3
	movem	t1,n.muot(uot)
au.se2:	move	c,n.rang(t1)
	caile	c,^d512
	  pjrst	a.mov7
	move	c,n.ener
	camge	c,[^d5000K]
	  pjrst	a.reen
	call	aunxtb
	  jrst	au.se3
	movem	t1,n.muot(uot)
	pjrst	a.mov7
au.se3:	movei	t1,^d1000
	pjrst	tqins
 
;*****	Ax.REF, MISSION 1
;
;	retreat to a base and refuel
 
AI.REF::
	move	c,n.ener
	camge	c,[^d2500K]
	call	aubase
	  retskp
	movem	t1,n.muot(uot)
	movei	c,1			;REF mission code.
	movem	c,n.mssn(uot)
	pjrst	au.ref
 
AC.REF::
	move	c,n.ener
	caml	c,[^d5000K]
	  pjrst	askipr
	move	t1,n.muot(uot)
	skipl	c,u.tab(t1)
	trnn	c,@alya.u
	  jrst	[call	aubase
		  pjrst	askipr
		 movem	t1,n.muot(uot)
		 jrst	.+1]
	pjrst	au.ref
 
AU.REF::
	hlrz	c,n.mssn(uot)
	jumpg	c,au.re2
au.re1:	move	c,n.rang(t1)
	caige	c,^d512
	  jrst	au.re9
	jrst	au.re8
au.re2:	movei	c,^d1024
	camge	c,nrpl.t
	caml	c,nrpl.n
	  jrst	au.re5
	caml	c,nrsb.t
	  jrst	au.re5
	skipg	t2,n.scnt
	  jrst	au.re9
	caile	t1,sb.mx
	  jrst	au.re6
	caile	t2,1
	  jrst	au.re4
	move	c,n.ener
	camge	c,[^d2000K]
	  jrst	au.re9
	movei	c,0
	hrlm	c,n.mssn(uot)
	move	t1,nush.t
	movei	t2,^d400
	pjrst	a.phas
au.re4:	call	aunxsb
	jrst	au.re7
au.re5:	caig	t1,sb.mx
	  jrst	au.re8
au.re6:	skipl	t1,nusb.u
	  jrst	au.re7
	move	t1,n.muot(uot)
	call	aunxtb
	  skipa	t1,n.muot(uot)
au.re7:	movem	t1,n.muot(uot)
au.re8:	movei	c,0
	hrlm	c,n.mssn(uot)
	caile	t1,sb.mx
	skipe	n.scnt
	  pjrst	a.mov8
	pjrst	a.mov7
au.re9:	movei	c,1
	hrlm	c,n.mssn(uot)
	pjrst	a.reen
 
;*****	Ax.ESH, MISSION 2
 
AI.ESH::
	move	c,nrsh.t
	caile	c,^d1024
	  retskp
	move	t1,nush.t
	movem	t1,n.muot(uot)
	movei	c,2			;ESH mission code.
	movem	c,n.mssn(uot)
	pjrst	au.es2
 
AC.ESH::
	move	t1,n.muot(uot)
	move	c,nrsh.t
	caig	c,^d1024
	  jrst	ac.es1
	move	c,n.rang(t1)
	caile	c,^d1536
	  pjrst	askipr
	hlrz	c,n.mssn(uot)
	jumpe	c,au.es3
	skipg	u.torp(uot)
	  pjrst	au.es3
	pjrst	au.es1
ac.es1:	cain	t1,nush.t
	  jrst	ac.es2
	move	t1,nush.t
	movem	t1,n.muot(uot)
	pjrst	au.es2
ac.es2:	hlrz	c,n.mssn(uot)
	jumpn	c,au.es2
	move	c,n.rang(t1)
	caig	c,^d256
	  pjrst	au.es2
	pjrst	au.es3
 
AU.ES1::
	movei	c,0
	hrlm	c,n.mssn(uot)
	pjrst	a.phot
AU.ES2::
	movei	c,0
	hrlm	c,n.mssn(uot)
	movei	t2,^d400
	pjrst	a.phas
AU.ES3::
	movei	c,1
	hrlm	c,n.mssn(uot)
	pjrst	a.mov7
 
;*****	Ax.EBA, MISSION 3
 
AI.EBA::
	move	c,n.pcnt
	caile	c,8
	skipg	t1,nusb.t
	  retskp
	movem	t1,n.muot(uot)
	movei	c,3				;EBA mission code.
	movem	c,n.mssn(uot)
	pjrst	au.eba
 
AC.EBA::
	move	t1,n.muot(uot)
	move	c,n.pcnt
	caile	c,8
	skipge	u.tab(t1)
	  pjrst	askipr
	movei	c,^d1024
	camle	c,nrsh.t
	  pjrst	askipr
	camg	c,nrpl.t
	camle	c,nrpl.n
	  pjrst	askipr
	pjrst	au.eba
 
AU.EBA::
	move	c,n.rang(t1)
	cail	c,^d2048
	  pjrst	a.mov7
	skiple	u.torp(uot)
	  pjrst	a.phot
	cail	c,^d1024
	  pjrst	a.mov7
	movei	t2,^d400
	pjrst	a.phas
 
;*****	Ax.CAP, MISSION 4
;
;	capture a planet.
 
AI.CAP::
	move	t1,nupl.t
	move	t2,nrpl.t
	camg	t2,nrpl.n
	  jrst	ai.ca1
	move	t1,nupl.n
	move	t2,nrpl.n
ai.ca1:	skipge	t1
	  retskp
	movei	c,4			;CAP mission code.
	movem	c,n.mssn(uot)
	movem	t1,n.muot(uot)
	pjrst	au.cap
 
AC.CAP::
	move	c,nrsh.t
	caig	c,^d1024
	  pjrst	askipr
	hrrz	t1,n.muot(uot)
	move	t2,n.rang(t1)
	pjrst	au.cap
 
AU.CAP::
	move	c,u.tab(t1)
	trne	c,@alya.u
	  pjrst	askipr
	cail	t2,^d512
	  pjrst	a.mov7
	tlnn	c,100
	  jrst	au.ca3
au.ca1:	aoj	t1,
	trnn	t1,3
	  jrst	au.ca2
	skipge	u.tab(t1)
	  jrst	au.ca1
	movei	t2,^d500
	pjrst	a.phas
au.ca2:	subi	t1,4
	save	uot
	move	uot,t1
	setz	t1,
	call	tqins
	rest	uot
	movei	t1,^d750
	pjrst	tqins
au.ca3:	setzm	n.mssn(uot)
	setom	n.muot(uot)
	move	c,u.tab(t1)
	trz	c,7b31
	ior	c,alya.u
	movem	c,u.tab(t1)
	movem	t1,^d1000
	pjrst	tqins
 
;*****	Ax.HLP, MISSION 5
 
AI.HLP::
	move	t3,u.alrt(uot)
	and	t3,mska.u
	skipn	t3
	  retskp
	movei	t1,7
	movei	t2,1b18
ai.hl1:	came	t1,uot
	tdnn	t3,t2
	  jrst	ai.hl2
	skipl	u.tab(t1)
	  jrst	ai.hl3
ai.hl2:	lsh	t2,-1
	sojge	t1,ai.hl1
	retskp
ai.hl3:	movem	t1,n.muot(uot)
	hrlm	t2,n.muot(uot)
	movei	c,5			;HLP mission code
	movem	c,n.mssn(uot)
	pjrst	au.hlp
 
AC.HLP::
	hrrz	t1,n.muot(uot)
	came	t1,uot
	skipge	u.tab(t1)
	  jrst	ac.hl1
	hlrz	t2,n.muot(uot)
	tdnn	t2,u.alrt(uot)
	  jrst	ac.hl1
	pjrst	au.hlp
ac.hl1:	andcam	t2,u.alrt(uot)
	pjrst	askipr
 
AU.HLP::
	move	c,n.rang(t1)
	caile	c,^d256
	  pjrst	a.mov7
	skiple	c,u.shld(t1)
	  jrst	au.hl9
	movm	c,c
	add	c,u.ener(t1)
	camle	c,[^d200K]
	  jrst	au.hl9
	move	c,mask.a
	hrli	c,4
	movsm	c,eadd.a
	movem	uot,eadd.b
	setzm	eadd.t
	save	t1,t2
	call	lqins
	rest	t1,t2
	move	c,u.ener(t1)
	add	c,[^d400K]
	movem	c,u.ener(t1)
	move	c,u.ener(uot)
	sub	c,[^d400K]
	movem	c,u.ener(uot)
	move	c,t2
	ior	c,uot
	hrli	c,10
	movsm	c,eadd.a
	movem	t1,eadd.b
	move	c,n.rang(t1)
	movem	c,eadd.t
	save	t2
	call	lqins
	rest	t2
	andcam	t2,u.alrt(uot)
	setzm	n.mssn(uot)
	setom	n.muot(uot)
	movei	t1,^d3000
	pjrst	tqins
au.hl9:	andcam	t2,u.alrt(uot)
	pjrst	askipr
 
 
;*****	SALLOC
;
;	allocates a percent of UOT's total energy to the shields.  T1
;	contains the integer percent, eg 50 for 50 percent.
 
SALLOC::
	save	t2,t3
	move	c,n.ener
	move	t2,c
	imul	t2,t1
	idivi	t2,^d100
	sub	c,t2
	movem	c,u.ener(uot)
	caig	t2,^d100000
	  movn	t2,t2
	movem	t2,u.shld(uot)
	rest	t2,t3
	ret
 
;*****	AUNXSB

AUNXSB::
	save	t2,t3,t4
	move	t2,uot
	andi	t2,1
	addi	t2,sb.mn
	setz	t3,
	seto	t4,
	tlz	t4,1b18
ans.1:	came	t2,t1
	skipge	u.tab(t2)
	  jrst	ans.2
	camg	t4,n.rang(t2)
	  jrst	ans.2
	move	t3,t2
	move	t4,n.rang(t2)
ans.2:	addi	t2,2
	caig	t2,sb.mx
	  jrst	ans.1
	skipe	t3
	  move	t1,t3
	rest	t2,t3,t4
	ret
 
;*****	AUBASE
;
;	returns uot of nearest base in T1, range in T2.  if no base exists,
;	T1 < 0 and non-skip, otherwise a skip ret.
 
AUBASE::
	move	t1,nupl.u
	move	t2,nrpl.u
	camg	t2,nrsb.u
	  jrst	.+3
	move	t1,nusb.u
	move	t2,nrsb.u
	skipl	t1
	  aos	(p)
	ret
 
;*****	AUNXTB
 
AUNXTB::
	movei	t2,sb.mn
	move	t3,t1
	call	aunxb
	  jrst	[sos	t2,t1
		 movei	t3,pl.mx
		 call	aunxb
		   ret
		 jrst	.+1]
	move	t1,t3
	aos	(p)
	ret
 
aunxb:	soj	t3,
	camge	t3,t2
	  ret
	skipl	c,u.tab(t3)
	trnn	c,@alya.u
	  jrst	aunxb
	andi	c,17
	cail	c,2
	caile	c,4
	  jrst	aunxb
	aos	(p)
	ret
 
;*****	A.REEN
 
A.REEN::
	move	t2,t1
	move	t1,uot
	call	reener
	movei	t1,^d1500
	pjrst	tqins
 
;*****	A.PHOT, A.PHAS
 
A.PHOT::
	sos	u.torp(uot)
	movsi	c,1b27
	hrri	c,^d200
	movem	c,a.fire
	skipa
A.PHAS::
	movem	t2,a.fire
	hrrz	c,a.fire
	imul	c,c
	exch	c,u.ener(uot)
	subm	c,u.ener(uot)
	call	authit
	movei	t1,^d3000
	pjrst	tqins
 
;*****	A.MOV7, A.MOV8, A.MOVE
 
A.MOV7::
	movei	t2,7
	pjrst	a.move
A.MOV8::
	movei	t2,8
	pjrst	a.move
A.MOVE::
	call	autxyz
	move	t1,n.rang(t1)
	call	autmot
	  skip
	movei	t1,^d1000
	pjrst	tqins
 
;*****	AUTMOT
;
;	moves UOT toward or away from coor A.ABSn at warp factor T2.
;	T2 > 0 moves toward, T2 < 0 moves away.  adjusts T2 down if
;	insufficient energy for move, after 50/50 reallocation.  skip
;	return if move okay.  non-skip return if ship needs energy.
;	T1 must contain range from UOT to coordinates.
 
AUTMOT::
	save	t1,t2
	movm	t3,t2
	move	c,u.ener(uot)
am.1:	caml	c,wf.ene(t3)
	  jrst	am.2
	sojge	t3,am.1
	rest	t1,t2
	ret
am.2:	rest	t1,t2
	move	c,wf.ene(t3)
	exch	c,u.ener(uot)
	subm	c,u.ener(uot)
	move	c,wf.dis(t3)
	skipge	t2
	  movn	c,c
	move	t2,c
	call	autmov
	aos	(p)
	ret
 
;*****	AUTXYZ
;
;	moves abs coordinates of object T1 to A.ABSn.
 
AUTXYZ::
	move	c,u.absx(t1)
	movem	c,a.absx
	move	c,u.absy(t1)
	movem	c,a.absy
	move	c,u.absz(t1)
	movem	c,a.absz
	ret
 
;*****	AUTDIS  (not referenced 1/8/81)
;
;	computes T1 = range between UOT and coordinates A.ABSn.

AUTDIS::
	move	c,u.absx(uot)
	fsbr	c,a.absx
	fmpr	c,c
	movem	c,f.data
	move	c,u.absy(uot)
	fsbr	c,a.absy
	fmpr	c,c
	fadrm	c,f.data
	move	c,u.absz(uot)
	fsbr	c,a.absz
	fmpr	c,c
	fadrm	c,f.data
	movei	c,f.loc
	call	sqrt.##
	fixr	t1,rs
	ret
 
;*****	AUTMOV
;
;	move object UOT toward (or away from) coordinates A.ABSX, A.ABSY,
;	A.ABSZ at warp T2.  T2 > 0 moves toward, T2 < 0 moves away.  T1
;	must contain range from UOT to coordinates.
 
AUTMOV::
	skipg	t1
	  ret
	save	p1,p2,p3
	fltr	t3,t2
	fltr	c,t1
	fdvr	t3,c
	move	t4,[1.0]
	fsbr	t4,t3
	fmprm	t3,a.absx
	move	p1,u.absx(uot)
	fmpr	p1,t4
	fadr	p1,a.absx
	fmprm	t3,a.absy
	move	p2,u.absy(uot)
	fmpr	p2,t4
	fadr	p2,a.absy
	fmprm	t3,a.absz
	move	p3,u.absz(uot)
	fmpr	p3,t4
	fadr	p3,a.absz
	movem	p1,u.absx(uot)
	movem	p2,u.absy(uot)
	movem	p3,u.absz(uot)
	rest	p1,p2,p3
	hrlz	c,mask.a
	hrri	c,1
	movem	c,eadd.a
	movem	uot,eadd.b
	setzm	eadd.t
	pjrst	lqins
 
;*****	ASKIPR
 
ASKIPR::
	setzm	n.mssn(uot)
	setom	n.muot(uot)
RSKP::	aos	(p)
R::	ret


 
;*****	SETUP
 
SETUP::
	setom	u.side
	call	intlok
	call	gamchk
	setz	t1,
	movei	suot,sh.mx
set.a:	move	c,u.tab(suot)
	tlne	c,3b19
	  aoj	t1,
	sojge	suot,set.a
	cail	t1,sh.ct
	  jrst	[typec	<All ships in play, try again later>
		 setzm	i.lock
		 gexit]
	type	<>
	skipe	gam.nr
	  jrst	[type	<Tournament Game >
		 outchr	gam.nr
		 crlf
		 jrst	.+2]
	typec	<Random Game>
	call	su.pla
	call	su.ava
	crlf
	crlf
	type	<Enter the initial of the ship you wish to command:  _7>
	jrst	set.g
set.e:	type	<_>
	type	<>
ife tops20,<clrbfi>
ifn tops20,<
	movei	t1,.priin
	cfibf
>
set.g:	inchrw	t1
	caig	t1," "
	  jrst	set.e+1
	outchr	t1
	trz	t1,1b30
	movem	t1,c.char
	movei	suot,7
set.h:	move	t2,[point 7,o.init(suot)]
	ildb	t2,t2
	camn	t2,c.char
	  jrst	set.n
	sojge	suot,set.h
	  jrst	set.e
set.n:	move	t2,u.tab(suot)
	tlne	t2,3b19
	  jrst	set.e
	skipl	u.side
	  jrst	[hrrz	c,suot
		 andi	c,1
		 came	c,u.side
		   jrst	set.e
		 jrst	.+1]
	tlo	t2,1b19
	movem	t2,u.tab(suot)
	getime	c
	setzm	time.q(suot)
	movem	suot,s.uot
	call	usrlod
	movei	t2,2000
	lsh	t2,@suot
	movem	t2,mask.c
	andcam	t2,mask.o
	tso	t2,mask.q
	movsm	t2,mask.q
	move	t2,mask.f
	move	c,suot
	andi	c,1
	movem	t2,mask.u(c)
	move	t2,ally.f
	movem	t2,ally.u(c)
set.x:	setzm	i.lock			;release the interlock (set in the
	ret				;  intlok routine) and ret.
 
GAMCHK::
ife tops20,<mstime t2,>
ifn tops20,<
	time
	move	t2,t1
>
	movei	uot,sh.mx+1
gchk.1:	sojl	uot,[setzm u.tty
		 move	c,[xwd u.tty,u.tty+1]
		 blt	c,u.tty+sh.mx
		 pjrst	select]
	skipl	c,u.tab(uot)
	tlnn	c,1b19
	  jrst	gchk.1
	move	c,u.time(uot)
	sub	c,t2
	skipg	c
	  movn	c,c
	camle	c,[^d300000]
	  jrst	gchk.1
ife tops20,<getlin c,>
ifn tops20,<
	save	t2
	gjinf
	move	c,t4
	rest	t2
>
	movei	uot,sh.mx+1
gchk.2:	sojl	uot,r
	came	c,u.tty(uot)
	  jrst	gchk.2
	move	c,uot
	andi	c,1
	movem	c,u.side
gchk.3:	skipl	u.tab(c)
	  jrst	gchk.4
	addi	c,2
	caig	c,sh.mx
	  jrst	gchk.3
	movei	t1,[asciz /Federation/]
	trne	c,1
	  movei	t1,[asciz /Klingon Empire/]
	type	<The >
	outstr	(t1)
	type	< has been defeated!>
	setzm	i.lock
	gexit
gchk.4:	move	t1,u.wait(uot)		;get the wait time.
	sub	t1,t2			;subtract the current time.
	idivi	t1,^d1000		;convert to seconds.
	jumple	t1,[setzm  u.tty(uot)	;if not > 0, reset the tty nr
		    ret]		;  and ret.
	type	<Re-entry in >	;must wait - type the wait message.
	idivi	t1,^d60			;display the time in mins and secs.
	push	p,t2			;routine displays minutes if minutes
	skipe	t1			;  are > 0, otherwise only displays
	  jrst	[push	p,t1		;  seconds.
		 call	timout
		 type	< minute>
		 movei	c,[asciz /s, /]
		 pop	p,t1
		 cain	t1,1
		  movei	c,[asciz /, /]
		 outstr	(c)
		 jrst	.+1]
	move	t1,0(p)
	call	timout
	type	< second>
	pop	p,t1
	caie	t1,1
	  type	<s>
	crlf
	setzm	i.lock
ife tops20,<exit 1,>				;exit from the game.
ifn tops20,<haltf>
	inchrw	c
	cain	c,"Z"
	  ret
	gexit
 
timout:	idivi	t1,^d10			;displays a number without leading
	save	t2			;  zeroes.
	skipe	t1
	  call	timout
	rest	t2
	addi	t2,"0"
	outchr	t2
	ret
 
;*****	INTLOK
;
;	prevents two players from starting up at the same time.  if i.lock < 0
;	hibers for a second and tries again.  when other player is finished
;	i.lock will be = 0.  this routine then sets i.lock < 0 to exclude
;	other players and returns.
 
INTLOK::
ife tops20,<mstime t1,>
ifn tops20,<time>
	skipn	i.lock
	  jrst	ilok.2
	move	c,t1			;compares current time with i.time,
	sub	c,i.time		;  which is the time the other player
	skipge	c			;  grabbed i.lock.  if the difference
	  movn	c,c			;  if > 5 mins, assume something is
	camle	c,[^d300000]		;  wrong (crash during startup) and
	  jrst	ilok.2			;  give player control immediately.
	type	<Start-up interlock, please stand by >
ilok.1:
ife tops20,<
	movsi	c,1b18			;causes immediate swap out.
	tro	c,1			;wait a jiffy.
	hiber	c,
	  skip				;hiber failure - ignore.
>
ifn tops20,<
	exch	c,t1
	movei	t1,^d1000		;wait 1
	disms
	exch	t1,c
>
	skipe	i.lock
	  jrst	ilok.1
ilok.2:	setom	i.lock			;lock others out.
	movem	t1,i.time		;save for future use by other startups.
	ret				;player now controls interlock.
 
;*****	SU.PLA
;
;	displays ships currently in play.
 
SU.PLA::
	movei	t1,sh.mx+1
su.pl0:	sojl	t1,r
	skipl	c,u.tab(t1)
	tlnn	c,1b19
	  jrst	su.pl0
	crlf
	typec	<Ships in play:>
	call	su.hed
	movei	c,15
	movni	t1,2
	movni	t2,1
su.pl1:	crlf
	setz	t3,
su.pl2:	cail	t1,6
	  jrst	su.pl3
	addi	t1,2
	skipl	t4,u.tab(t1)
	tlnn	t4,1b19
	  jrst	su.pl2
	outchr	c
	type	<  >
	outstr	@o.name(t1)
	outchr	c
	type	<>
	move	uot,t1
	call	su.usr
	seto	t3,
su.pl3:	cail	t2,7
	  jrst	su.pl4
	addi	t2,2
	skipl	t4,u.tab(t2)
	tlnn	t4,1b19
	  jrst	su.pl3
	outchr	c
	type	<>
	outstr	@o.name(t2)
	outchr	c
	type	<>
	move	uot,t2
	call	su.usr
	jrst	su.pl1
su.pl4:	jumpn	t3,su.pl1
	ret
 
su.usr:	type	<(>
ife tops20,<
	move	p4,u.nam1(uot)
	call	su.six
	move	p4,u.nam2(uot)
	call	su.six
>
ifn tops20,<
	save	t1,t2
	movei	t1,.priou
	move	t2,u.namx(uot)
	dirst
	 jfcl
	rest	t1,t2
>
	type	<)>
	ret
 
ife tops20,<
su.six:	movei	p1,6
	setz	p3,
	lshc	p3,6
	addi	p3,40
	outchr	p3
	sojg	p1,.-4
	ret
> 

;*****	SU.AVA
;
;	displays ships currently available.
 
SU.AVA::
	crlf
	typec	<Available ships:>
	call	su.hed
	movei	c,15
	movni	t1,2
	movni	t2,1
su.av1:	crlf
	setz	t3,
su.av2:	skipg	u.side
	cail	t1,6
	  jrst	su.av3
	addi	t1,2
	move	t4,u.tab(t1)
	tlne	t4,3b19
	  jrst	su.av2
	outchr	c
	type	<  >
	outstr	@o.name(t1)
	seto	t3,
su.av3:	skipe	u.side
	cail	t2,7
	  jrst	su.av4
	addi	t2,2
	move	t4,u.tab(t2)
	tlne	t4,3b19
	  jrst	su.av3
	outchr	c
	type	<>
	outstr	@o.name(t2)
	jrst	su.av1
su.av4:	jumpn	t3,su.av1
	ret
 
su.hed:	crlf
	outstr	su.ln1
	crlf
	outstr	su.ln2
	ret
 
usrlod:
ife tops20,<
	pjob	t1,
	movem	t1,u.job(suot)
	getlin	t1,
	movem	t1,u.tty(suot)
	move	t1,[xwd -1,31]
	gettab	t1,
	skip
	movem	t1,u.nam1(suot)
	move	t1,[xwd -1,32]
	gettab	t1,
	skip
	movem	t1,u.nam2(suot)
	move	t1,[xwd -1,2]
	gettab	t1,
	skip
	movem	t1,u.ppn(suot)
>
ifn tops20,<
	gjinf
	movem	t3,u.job(suot)
	movem	t1,u.namx(suot)
	movem	t4,u.tty(suot)
>
	ret
 
;*****	ROTRAN
 
ROTRAN::
	movei	c,^d360
	movem	c,ran.mx
	setzm	ran.mn
	call	random
	fltr	t1,t1
	movem	t1,b1
	call	random
	fltr	t1,t1
	movem	t1,e1
	call	rot.zy
	ret
 
;*****	SELECT
;
;	first player in the game selects startup options.  this routine
;	initializes the game.
 
SELECT::
	type	<Enter a tournament number from 1 to 9 >
	typec	<to load a tournament game;>
	type	<Enter any other character to load a random game:  _7>
	inchrw	p2
	outchr	p2
ife tops20,<
	cain	p2,15
	  jrst	.-3			;if CR, get the LF.
>
	crlf				;display CRLF to acknowledge.
	cail	p2,"1"
	caile	p2,"9"
	jrst	sel.rn
sel.tr:	movem	p2,gam.nr		;tournament game:
	andi	p2,17			;  cycle the randomizer 3 * tournament
	imuli	p2,3			;  number times.
	call	random
	sojg	p2,.-1
	jrst	sel.ld
sel.rn:	setzm	gam.nr			;random game:
	call	ranset			;  seed the randomizer with mstime.
sel.ld:	call	loadq			;init the queue.
	pjrst	loadu			;init the universal object table.
 
;*****	LOADQ
;
;	Initializes the event queue.
 
LOADQ::
	move	c,[xwd 1777,777777]
	movem	c,mask.q
	setzm	q
	move	c,[xwd q,q+1]
	blt	c,q+q.size-1
	setzm	time.q
	move	c,[xwd time.q,time.q+1]
	blt	c,time.q+117
	ret
 
;*****	LOADU
;
;	Loads the universal object table.  All objects are loaded,
;	including inactive ships.  Objects are spaced a minimum of
;	512 units from each other.
 
LOADU::
	setz	uot,
lu.nxt:	call	lu.uot
	cain	t1,7
	jrst	.+6
	call	lu.lim	;get range limits
	call	lu.xyz	;get universal x, y, and z
	call	lu.tst	;test 512 distances
	 jrst	.-2		;not 512 from all other objects
	call	lu.mov	;move universal x, y, and z to uot
	caige	uot,217		;all objects loaded?
	aoja	uot,lu.nxt	;no, repeat for next object
	ret			;table loaded
 
lu.uot:	move	t1,u.tab(uot)
	andi	t1,7
	move	c,ui.t0(t1)
	movem	c,u.tab(uot)
	move	c,ui.e0(t1)
	movem	c,u.ener(uot)
	move	c,ui.s0(t1)
	movem	c,u.shld(uot)
	caile	uot,7
	  ret
	movei	c,^d10
	movem	c,u.torp(uot)
	movei	c,^d10000
	movem	c,time.q(uot)
	move	c,uot
	tro	c,10
	movem	c,n.muot(uot)
	setzm	n.mssn(uot)
	setzm	u.absx(uot)
	setzm	u.absy(uot)
	setzm	u.absz(uot)
	setzm	u.alrt(uot)
	setzm	u.time(uot)
	setzm	u.job(uot)
	setzm	u.tty(uot)
ife tops20,<
	setzm	u.ppn(uot)
	setzm	u.nam1(uot)
	setzm	u.nam2(uot)
>
ifn tops20,<
	setzm	u.namx(uot)
>
	ret
 
lu.lim:	movei	t2,1
	cain	t1,1		;star?
	jrst	[movei	t1,^d4000
		 jrst	lu.lm1]
	cain	t1,2		;planet?
	jrst	[movei	t1,^d2000
		 jrst	lu.lm1]
	movei	t2,^d1250	;set narrow limits
	movei	t1,^d2250	;assures a reasonable separation
lu.lm1:	movem	t2,ran.mn	;save as random number generator
	movem	t1,ran.mx	;  min and max range
	aos	t2,xyz.i
	cail	t2,10
	setzb	t2,xyz.i
	ret			;return to calling routine
 
lu.xyz:	call	random		;get random x (ran.nr is also in t1)
	movem	t1,x1		;save as x
	call	random		;get random y
	movem	t1,y1		;save as y
	call	random		;get random z
	movem	t1,z1		;save as z
	call	lu.str
	jrst	lu.xyz
	move	t2,xyz.i
	move	t2,xyz.t(t2)
	move	t1,x1
	trnn	t2,4		;test if x is to be negative
	movn	t1,t1		;(3 tests will select 1 of 8 sectors)
	fltr	t1,t1		;convert to floating point
	movem	t1,x1		;save as x
	move	t1,y1
	trnn	t2,2		;test if y is to be negative
	movn	t1,t1		;(the 2nd test)
	fltr	t1,t1		;convert to floating point
	movem	t1,y1		;save as y
	move	t1,z1
	trnn	t2,1		;test if z is to be negative
	movn	t1,t1		;(the 3rd test)
	fltr	t1,t1		;convert to floating point
	movem	t1,z1		;save as z
	ret			;return to calling routine
 
lu.str:	aos	(p)
	move	t1,u.tab(uot)
	andi	t1,7
	caie	t1,1
	ret
	movei	t1,^d2000
	camg	t1,x1
	ret
	camg	t1,y1
	ret
	camle	t1,z1
	sos	(p)
	ret
 
lu.tst:	jumpg	uot,.+3		;don't test if 1st element
	aos	(p)		;form skip ret
	ret			;return to calling routine
	movn	t3,uot
	hrlz	t3,t3
lu.ts1:	move	t1,u.tab(t3)
	andi	t1,7
	cain	t1,7
	jrst	lu.ts2
	move	t1,x1		;distance formula:
	fsbr	t1,u.absx(t3)	;  d ** 2 =
	fmpr	t1,t1		;     (x - ux) ** 2) +
	movem	t1,t2		;     (y - uy) ** 2) +
	move	t1,y1		;     (z - uz) ** 2)
	fsbr	t1,u.absy(t3)
	fmpr	t1,t1
	fadrm	t1,t2
	move	t1,z1
	fsbr	t1,u.absz(t3)
	fmpr	t1,t1
	fadrm	t1,t2
	camg	t2,[262144.0]	;must be greater that 512 ** 2
	ret			;failed test
lu.ts2:	aobjn	t3,lu.ts1	;try the next entry
	aos	(p)		;passed test for all entries
	ret

lu.mov:	move	t2,u.tab(uot)
	andi	t2,7
	move	t1,x1			;get x
	movem	t1,u.absx(uot)		;store x
;	caig	uot,7
;	movem	t1,u.begx(uot)
	cain	t2,2
	movem	t1,1+u.absx(uot)
	move	t1,y1			;get y
	movem	t1,u.absy(uot)		;store y
;	caig	uot,7
;	movem	t1,u.begy(uot)
	cain	t2,2
	movem	t1,2+u.absy(uot)
	move	t1,z1			;get z
	movem	t1,u.absz(uot)		;store z
;	caig	uot,7
;	movem	t1,u.begz(uot)
	cain	t2,2
	movem	t1,3+u.absz(uot)
	ret			;return to calling routine
 
;*****	RANSET
;
;	Seeds the Fortran random number generator with the current
;	time of day.
 
RANSET::
ife tops20,<mstime t1,>
ifn tops20,<time>
	movem	t1,ran.sd
	push	sp,rs
	push	sp,ap
	movei	ap,[0,,ran.sd]
	call	setran##
	pop	sp,ap
	pop	sp,rs
	ret
 
;*****	RANDOM
;
;	Gets a random number ran.nr between ran.mn and ran.max from the
;	Fortran random number generator.
 
RANDOM::
	move	t1,ran.mx	;the formula is
	sub	t1,ran.mn	;  nbr = min + ran * (max - min + 1)
	aoj	t1,		;  where 0 < ran < 1
	fltr	t1,t1
	save	t1		;RAN uses t1
	setz	rs,
	call	ran##		;number is reted in AC0
	rest	t1
	fmpr	t1,rs
	fix	t1,t1
	add	t1,ran.mn
	movem	t1,ran.nr
	ret
 
;*****	INIPSI
;
;	Initializes ctrl-c trapping.
 
INIPSI::
ife tops20,<
	movei	ap,ivb
	piini.	ap,
	  jrst	[typec	<PIINI error>
		 exit	1,
		 exit]
	move	ap,[exp ps.fac+ps.fon+ccarg]
	pisys.	ap,
	  jrst	[typec	<PISYS error (CCTRAP)>
		 exit	1,
		 exit]
>
ifn tops20,<
	cis			;clear int system
	movei	t1,ictrap
	hrrm	t1,chntab+1	
	movei	t1,.fhslf
	move	t2,[levtab,,chntab]
	sir
	eir			;enable ints
	movx	t2,1b1!1b2	;chls 1 and 2
	aic
	move	t1,[.ticcc,,1]	;put ctrl-c on chl 1
	ati
	 erjmp	.+1		; in case user has disabled this
	move	t1,[.ticti,,2]	;put typein on chl 2
	ati
>
	ret
 
;*****	ICTRAP
 
ICTRAP::
	type	<>
	setzm	i.lock
	call	ttyrst
	movei	ap,icend
ife tops20,<
	movem	ap,ivb+1
	debrk.
	  skip
>
ifn tops20,<
	movem	ap,lev1pc
	debrk
	 erjmp	.+1
>
icend:	gexit

;*****	CCTRAP
 
CCTRAP::
	type	<>
	call	stwait
	move	c,u.tab(suot)
	tlz	c,1b19
	movem	c,u.tab(suot)
	call	wrapup
	movei	ap,ccend
ife tops20,<
	movem	ap,ivb+1
	debrk.
	  skip
>
ifn tops20,<
	movem	ap,lev1pc
	debrk
	 erjmp	.+1
>
ccend:	gexit

;****	STWAIT
;
;	Sets the mstime after which a player may reenter the game.
 
STWAIT::
ife tops20,<
	mstime	c,			;get current time.
	add	c,[dec 120000]		;add 2 minutes.
	caml	c,[dec 86400000]	;check whether past midnight.
	  sub	c,[dec 86400000]	;it is - subtract 24 hrs.
>
ifn tops20,<
	exch	c,t1
	time
	add	t1,[dec 120000]		;add 2 minutes
	exch	t1,c
>
	movem	c,u.wait(suot)		;save as time to wait.
	ret
 
;*****	WRAPUP
;
;	Performs cleanup after a ship is destroyed, quits, or
;	control-c's.
 
WRAPUP::
	movsi	c,2000
	lsh	c,@suot
	andcam	c,mask.q
	movs	c,mask.c
	movs	t1,mask.a
	movei	p1,q.size-6
wrup.1:	skipg	evnt.t(p1)
	  jrst	wrup.2
	andcam	c,evnt.a(p1)
	tdnn	t1,evnt.a(p1)
	  setzm	evnt.t(p1)
wrup.2:	subi	p1,6
	jumpge	p1,wrup.1
wrup.3:	movei	c,^d5000
	movem	c,time.q(suot)
ife tops20,<
	clrbfi
	type	<(B>
	releas	ttychn,
	  skip
>
ifn tops20,<
	movei	t1,.priin
	cfibf
	type	<(B>
>
	call	ttyrst
	ret



;*****	OBLOAD
 
OBLOAD::
	call	otabld
	call	scanld
	call	tarupd
	call	viewld
	ret
 
;*****	OTABLD
 
OTABLD::
	movei	uot,217
	skipge	u.tab(uot)
	  jrst	[move	ap,[9999.0]
		 movem	ap,o.rang(uot)
		 jrst	.+3]
	came	uot,suot
	  call	rbelod
	sojge	uot,.-4
	ret
 
;*****	RBELOD
 
RBELOD::
	move	t1,u.absx(uot)
	movem	t1,x1
	move	t1,u.absy(uot)
	movem	t1,y1
	move	t1,u.absz(uot)
	movem	t1,z1
	call	rbecmp
	move	t1,x1
	movem	t1,o.relx(uot)
	move	t1,y1
	movem	t1,o.rely(uot)
	move	t1,z1
	movem	t1,o.relz(uot)
	move	t1,r1
	movem	t1,o.rang(uot)
	move	t1,b1
	movem	t1,o.bear(uot)
	move	t1,e1
	movem	t1,o.elev(uot)
	ret
 
;*****	RBECMP
 
RBECMP::
	move	t1,x1
	fsbr	t1,u.absx(suot)
	movem	t1,x2
	move	t1,y1
	fsbr	t1,u.absy(suot)
	movem	t1,y2
	move	t1,z1
	fsbr	t1,u.absz(suot)
	movem	t1,z2
	move	t1,x2
	fmpr	t1,s.11
	movem	t1,x1
	move	t1,y2
	fmpr	t1,s.12
	fadrm	t1,x1
	move	t1,z2
	fmpr	t1,s.13
	fadrm	t1,x1
	move	t1,x2
	fmpr	t1,s.21
	movem	t1,y1
	move	t1,y2
	fmpr	t1,s.22
	fadrm	t1,y1
	move	t1,z2
	fmpr	t1,s.23
	fadrm	t1,y1
	move	t1,x2
	fmpr	t1,s.31
	movem	t1,z1
	move	t1,y2
	fmpr	t1,s.32
	fadrm	t1,z1
	move	t1,z2
	fmpr	t1,s.33
	fadrm	t1,z1
	move	t1,x1
	fmpr	t1,t1
	movem	t1,x2
	movem	t1,f.data
	move	t1,y1
	fmpr	t1,t1
	movem	t1,y2
	fadrm	t1,f.data
	move	t1,z1
	fmpr	t1,t1
	movem	t1,z2
	fadrm	t1,f.data
	movei	c,f.loc
	call	sqrt.##
	movem	rs,r1
	move	t1,y1
	fdvr	t1,x1
	movem	t1,b1
	move	t1,x2
	fadr	t1,y2
	movem	t1,f.data
	movei	c,f.loc
	call	sqrt.##
	move	t1,z1
	fdvr	t1,rs
	movem	t1,e1
	ret
 
;*****	ROT.ZY
 
ROT.ZY::
	move	t1,b1
	call	sincos
	call	rot.z
	move	t1,e1
	call	sincos
	call	rot.y
	ret
 
;*****	ROT.X
 
ROT.X::
	call	savmat
	move	t1,a.21		;s.21 = (a.31 * sin.a) + (a.21 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.21
	move	t1,a.31
	fmpr	t1,sin.a
	fadrm	t1,s.21
	move	t1,a.21		;s.31 = (a.31 * cos.a) - (a.21 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.31
	move	t1,a.31
	fmpr	t1,cos.a
	fsbrm	t1,s.31
	move	t1,a.22		;s.22 = (a.32 * sin.a) + (a.22 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.22
	move	t1,a.32
	fmpr	t1,sin.a
	fadrm	t1,s.22
	move	t1,a.22		;s.32 = (a.32 * cos.a) - (a.22 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.32
	move	t1,a.32
	fmpr	t1,cos.a
	fsbrm	t1,s.32
	move	t1,a.23		;s.23 = (a.33 * sin.a) + (a.23 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.23
	move	t1,a.33
	fmpr	t1,sin.a
	fadrm	t1,s.23
	move	t1,a.23		;s.33 = (a.33 * cos.a) - (a.23 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.33
	move	t1,a.33
	fmpr	t1,cos.a
	fsbrm	t1,s.33
	ret
 
;*****	ROT.Y
 
ROT.Y::
	call	savmat
	move	t1,a.11		;s.11 = (a.31 * sin.a) + (a.11 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.11
	move	t1,a.31
	fmpr	t1,sin.a
	fadrm	t1,s.11
	move	t1,a.11		;s.31 = (a.31 * cos.a) - (a.11 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.31
	move	t1,a.31
	fmpr	t1,cos.a
	fsbrm	t1,s.31
	move	t1,a.12		;s.12 = (a.32 * sin.a) + (a.12 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.12
	move	t1,a.32
	fmpr	t1,sin.a
	fadrm	t1,s.12
	move	t1,a.12		;s.32 = (a.32 * cos.a) - (a.12 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.32
	move	t1,a.32
	fmpr	t1,cos.a
	fsbrm	t1,s.32
	move	t1,a.13		;s.13 = (a.33 * sin.a) + (a.13 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.13
	move	t1,a.33
	fmpr	t1,sin.a
	fadrm	t1,s.13
	move	t1,a.13		;s.33 = (a.33 * cos.a) - (a.13 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.33
	move	t1,a.33
	fmpr	t1,cos.a
	fsbrm	t1,s.33
	ret
 
;*****	ROT.Z
 
ROT.Z::
	call	savmat
	move	t1,a.11		;s.11 = (a.21 * sin.a) + (a.11 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.11
	move	t1,a.21
	fmpr	t1,sin.a
	fadrm	t1,s.11
	move	t1,a.11		;s.21 = (a.21 * cos.a) - (a.11 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.21
	move	t1,a.21
	fmpr	t1,cos.a
	fsbrm	t1,s.21
	move	t1,a.12		;s.12 = (a.22 * sin.a) + (a.12 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.12
	move	t1,a.22
	fmpr	t1,sin.a
	fadrm	t1,s.12
	move	t1,a.12		;s.22 = (a.22 * cos.a) - (a.12 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.22
	move	t1,a.22
	fmpr	t1,cos.a
	fsbrm	t1,s.22
	move	t1,a.13		;s.13 = (a.23 * sin.a) + (a.13 * cos.a)
	fmpr	t1,cos.a
	movem	t1,s.13
	move	t1,a.23
	fmpr	t1,sin.a
	fadrm	t1,s.13
	move	t1,a.13		;s.23 = (a.23 * cos.a) - (a.13 * sin.a)
	fmpr	t1,sin.a
	movem	t1,s.23
	move	t1,a.23
	fmpr	t1,cos.a
	fsbrm	t1,s.23
	ret
 
savmat:	move	t1,[s.11,,a.11]
	blt	t1,a.11+^d8
	ret
 
;*****	SINCOS
 
SINCOS::
	save	t1,t2
	movei	ap,f.loc
	movem	t1,f.data
	call	sind.##
	movem	rs,sin.a
	call	cosd.##
	movem	rs,cos.a
	rest	t1,t2
	ret
 
;*****	CONUOT
 
CONUOT::
	move	t1,o.bear(uot)
	movem	t1,b1
	move	t1,o.elev(uot)
	movem	t1,e1
	move	t1,o.rang(uot)
	movem	t1,r1
	move	t1,o.relx(uot)
	movem	t1,x1
	move	t1,o.rely(uot)
	movem	t1,y1
	move	t1,o.relz(uot)
	movem	t1,z1
	call	conang
	ret
 
;*****	CONANG
 
CONANG::
	move	ap,e1
	call	atana
	movem	rs,e1
	move	ap,b1
	call	atana
	skipl	x1
	jrst	.+5
	move	ap,[-180.0]
	skipg	rs
	movm	ap,ap
	fadr	rs,ap
	movem	rs,b1
	ret
 
;*****	CONTRC
 
CONTRC::
	move	row,t.elev
	fmpr	row,[-0.25]
	fadr	row,[7.0]
	fixr	row,row
	move	col,t.bear
	fmpr	col,[0.625]
	fadr	col,[41.0]
	fixr	col,col
	ret
 
;*****	CONURC
 
CONURC::
	move	row,e1
	fmpr	row,[-0.25]
	fadr	row,[7.0]
	fixr	row,row
	move	col,b1
	fmpr	col,[0.625]
	fadr	col,[41.0]
	fixr	col,col
	ret
 
;*****	ATANA
 
ATANA::
	call	fatan
	fmpr	rs,[57.29577951]
	ret
 
;*****	FATAN
 
FATAN::
	save	t1,t2,t3
	movem	c,f.data
	movei	c,f.loc
	call	atan.##
	rest	t1,t2,t3
	ret
 
;*****	VTCMD
;
;	Gets a command sequence from the terminal, returns the following:
;
;		c.cmd	-  nbr of the command (0 = no cmd)
;		c.dir	-  direction
;				0 = no direction
;				1 = up     (FED or FWD)
;				2 = down   (KLI or BAK)
;				3 = right  (ALL)
;				4 = left   (PLA)
;				5 = help
;		c.nbr1	-  1st number
;		c.nbr2	-  2nd number
;		c.cnt	-  number of numbers entered
;		c.imm	-  immediate execute flag
;				 0 = no immediate command
;				 1 = SR SCAN (FED)
;				 2 = SR SCAN (KLI)
;				 3 = SR SCAN (ALL)
;				 4 = SR SCAN (PLA)
;				 5 = LR SCAN
;				 6 = RAPID FIRE PAHSER
;				 7 = RAPID FIRE PHOTON
;				-1 = more
 
VTCMD::
	type	<8>
	setzm	c.imm		;reset the immediate flag
	skiple	ap,c.dir
	caie	ap,5
	skipa
	  jrst	[setzm	c.dir
		 type	< 8>
		 jrst	.+1]
 
vc.1st:	call	vcget		;get 1st char of 1st field
	  jrst	vc.exe		;execute entry comes back here
	  jrst	vc.hlp		;help requests come back here
	  jrst	vc.can		;cmd cancel comes back here
	  jrst	vc.can		;backspace (delete) comes back here
	call	vc.imm		;test immediate entry (arrow)
	  jrst	vc.exe		;immediate execute
	setzm	c.cmd		;reset the reted variables
	setzm	c.dir		;  can't reset these up front because
	setzm	c.nbr1		;  an execute can mean repeat a previous
	setzm	c.nbr2		;  command
	setzm	c.cnt		;
	caie	t1,""		;escape sequence?
	  jrst	vc.1c		;no - try letters
	call	vc.ifn		;keypad function (escape followed by number)?
	  jrst	vc.1a		;no - perhaps the keypad dash
	andi	t2,17		;convert ascii to binary
	aoj	t2,		;increment to form command nbr
	jrst	vc.1b		;jump to keypad routine
vc.1a:	caie	t2,"-"		;was it the keypad dash?
	  jrst	vc.1er		;no - error
	movei	t2,^d11		;yes - substitute 11
vc.1b:	movem	t2,c.cmd	;store the command nbr
	call	vc.kbd		;display the abbr from the cmd table
	  jrst	vc.2nd		;go get the 2nd field
vc.1c:	caie	t1,0		;is the vcget integer equal to zero?
	  jrst	vc.1er		;no - error
	call	vc.ifa		;is the vcget character a letter?
	  jrst	vc.1er		;no - error
	type	<>	;position the cursor
	outchr	t2		;display the letter
	type	<               8>	;display space and restore cursor
	lsh	t2,7		;shift the letter left one ascii position
	movem	t2,i.char	;save the entry
	call	vcget		;get the next character
	  jrst	vc.1d		;must validate the cmd (exe ret)
	  jrst	vc.1d		;must validate the cmd (hlp ret)
	  jrst	vc.can		;cancel the command
	  jrst	vc.can		;backspace is equivalent to cancel
	caie	t1,0		;is the vcget integer a zero?
	  jrst	vc.1d		;no - validate 1-char command
	call	vc.ifa		;yes - is the vcget char a letter?
	jrst	vc.1d		;not a letter - validate 1-char
	type	<>	;it was a letter - position cursor
	outchr	t2		;display the letter (conditionally)
	type	<8>		;restore the cursor
	iorm	t2,i.char	;combine it with the first letter
	call	vc.tab		;find both letters in the table
	jrst	vc.1er		;invalid command, cancel it
	jrst	vc.2nd		;valid - go get 2nd field
vc.1d:	movei	t3," "		;move space
	iorm	t3,i.char	;add it as the second cmd character
	call	vc.tab		;valid command?
	jrst	vc.1er		;no - cancel the command
	cain	t1,^d13		;was execute the last entry?
	jrst	vc.exe		;yes (no params entered)
	cain	t2,"?"		;was help the last entry?
	jrst	vc.hlp		;yes
	jrst	vc.2a		;assume the 1st letter of 2nd field
vc.1er:	type	<>		;signal an error
	type	<                 8>
	jrst	vc.1st		;go back to 1st field
 
vc.2bk:	type	<     8>	;(backspace function)
	setzm	c.dir		;reset dir
	setzm	c.nbr1		;reset nbr1
	setzm	c.cnt		;reset the count
vc.2nd:	call	vcget		;get 1st char of 2nd field
	jrst	vc.exe		;no 2nd field - execute (no params)
	jrst	vc.hlp		;request for help on given cmd
	jrst	vc.can		;cancel command
	jrst	vc.can		;backspace is equivalent to cancel here
vc.2a:	move	t3,c.cmd
	cain	t3,^d20
	jrst	vc.2s
	movei	t3,^d47		;entry point when input char is pending
	call	vc.col		;setup columns for 2nd field
	setz	t4,		;zero the offset for arrow entries
	call	vc.arr		;test if arrow was entered
	jrst	vc.3rd		;yes - go on to 3rd field
	call	vc.num		;number or sign?
	jrst	vc.2b		;yes - get rest of 2nd field
	type	<>		;no - signal error
	jrst	vc.2nd		;get the 1st char of 2nd field
vc.2s:	call	vc.sen
	jrst	vc.exe
	type	<>
	jrst	vc.2nd
vc.2b:	call	vcget		;get the next char of 2nd field
	jrst	vc.2c		;execute - must compute nbr1 first
	jrst	vc.2er		;help not allowed here
	jrst	vc.can		;cancel the command
	jrst	vc.2bk		;backspace to beginning of 2nd field
	call	vc.num		;test for number or sign
	jrst	vc.2b		;was a number or sign - get next char
vc.2c:	move	t3,i.nbr	;get the work number
	skipe	i.sign		;is the sign negative?
	movns	t3,i.nbr	;yes - form the negative
	movem	t3,c.nbr1	;store in 1st number
	aos	c.cnt		;increment the count
	cain	t1,^d13		;was the last command an execute?
	jrst	vc.exe		;yes - skip field 3
	movei	t4,7		;setup 3rd field offset if arrow
	setzm	i.path		;reset direction flag - assume 2 nbrs
	call	vc.arr		;no - was it an arrow?
	jrst	vc.4th		;an arrow - get the terminator
	call	vc.brk		;was the entry a break character?
	jrst	vc.3rd		;yes - start the 3rd field
vc.2er:	type	<>		;none of the above - therefore an error
	jrst	vc.2b		;get another character
 
vc.3bk:	type	<     8>	;(backspace function)
	skipe	i.path		;has a number been entered?
	setzm	c.nbr1		;no - reset nbr1
	setzm	c.nbr2		;yes - reset nbr2 in any case
vc.3rd:	call	vcget		;get 1st char of 3rd field
	jrst	vc.exe		;no 3rd field - execute
	jrst	vc.3x		;help not allowed here
	jrst	vc.can		;cancel the command
	jrst	vc.2bk		;backspace to 2nd field
	movei	t3,^d54		;setup columns for 3rd field
	call	vc.col		;  starting at col 54
	call	vc.num		;was the entry a number or a sign?
	jrst	vc.3b		;yes - get the rest of 3rd field
	skipe	i.path		;has an arrow been entered already?
	jrst	vc.3x		;yes - skip the arrow test
	setz	t4,		;zero the offset for arrow entries
	call	vc.arr		;was an arrow entered?
	jrst	vc.4th		;an arrow - get the terminator
vc.3x:	type	<>		;none of the above - signal an error
	jrst	vc.3rd		;restart at 3rd field
vc.3b:	call	vcget		;get the next char of the 3rd field
	jrst	vc.3c		;execute - must compute nbr first
	jrst	vc.3er		;help not allowed here
	jrst	vc.can		;cancel the command
	jrst	vc.3bk		;backspace to beginning of 3rd field
	call	vc.num		;number or sign entered?
	jrst	vc.3b		;yes - get more
vc.3c:	move	t3,i.nbr	;get the work nbr
	skipe	i.sign		;is the sign negative?
	movns	t3,i.nbr	;yes - form a negative number
	skipe	i.path		;is this the 2nd number?
	jrst	.+3		;no - store in nbr1
	movem	t3,c.nbr2	;yes - store it
	jrst	.+2		;skip the next
	movem	t3,c.nbr1	;store in nbr1
	aos	c.cnt		;increment the count
	cain	t1,^d13		;was the last character entered an execute?
	jrst	vc.exe		;yes - skip the terminator
vc.3er:	type	<>		;none of the above - an error
	jrst	vc.3b		;get the next character
 
vc.4er:	type	<>		;signal an error
vc.4th:	call	vcget		;get a terminator
	jrst	vc.exe		;the desired response
	jrst	vc.4er		;help not allowed at this point
	jrst	vc.can		;cancel the command
	jrst	.+2		;backspace to field 3
	jrst	vc.4er		;must be a terminator
	setzm	c.dir		;reset the direction
	setzm	i.path		;reset the direction-entered flag
	type	<     8>
	jrst	vc.3rd		;go back to 3rd field
vc.hlp:	type	<?8>	;display a "?"
	movei	t1,5		;move 5 to direction, indicating
	movem	t1,c.dir	;  request for help
vc.exe:	type	<8>
	ret			;the end of the routine
 
vc.can:	setzm	c.cmd		;reset the command nbr
	setzm	c.dir		;reset the direction
	setzm	c.nbr1		;reset the 1st nbr
	setzm	c.nbr2		;reset the 2nd nbr
	setzm	c.cnt		;reset the count
	type	<                 8>
	jrst	vc.1st		;go back to the beginning
 
vc.imm:	aos	(sp)		;form skip - assume not immediate
	caie	t1,""		;escape sequence?
	  ret		;no - can't be immediate (arrow)
	cain	t2,"0"		;keypad zero? (LR SCAN)
	  jrst	[movei	t2,5	;yes
		 jrst	vc.imx]
	cain	t2,"."		;keypad period? (MORE)
	  jrst	[seto	t2,	;yes
		 jrst	vc.imx]
	cail	t2,"A"		;is the character
	caile	t2,"D"		;  one of the letters A, B, C, or D?
	skipa			;no
	  jrst	[andi	t2,7	;yes - mask out all but last three bits
		 jrst	vc.imx]
	skipn	r.fire		;rapid fire enabled?
	  ret		;no - ret
	caie	t2,"5"		;rf phasers?
	cain	t2,"6"		;rf photon torpedo?
	skipa			;yes
	  ret		;no
	andi	t2,7		;mask the bits
	aoj	t2,		;incr to form immediate cmd
vc.imx:	movem	t2,c.imm	;store as the immediate flag
	sos	(sp)		;cancel the skip
	ret			;return to calling routine
 
vc.kbd:	type	<>	;position the cursor at 1st field
	move	t3,c.cmd	;get the command nbr
	hrrz	t3,c.tab(t3)	;move the command abbr
	lsh	t3,^d22		;form an asciz literal
	outstr	t3		;display it
	type	<              8>	;clear and restore cursor
	ret			;return to calling routine
 
vc.col:	movem	t3,i.spos	;store sign position
	aoj	t3,		;add 1
	movem	t3,i.pos	;store as first nbr position
	addi	t3,3		;compute the last allowable position
	movem	t3,i.max	;  and store it
	setzm	i.nbr		;reset the work nbr
	setzm	i.sign		;reset the sign flag
	ret			;return to calling routine
 
vc.arr:	aos	(sp)		;form skip - assume not an arrow
	caie	t1,""		;escape sequence?
	ret			;no - can't be an arrow
	move	t3,i.spos	;get the cursor position
	add	t3,t4		;add the offset, if any
	cail	t2,"A"		;is the character
	caile	t2,"D"		;  one of the letters A, B, C, or D?
	  ret			;no - return to calling routine
	sos	(sp)		;yes - cancel the skip - it's an arrow
	call	vpos		;position the cursor
	andi	t2,7		;convert char to a directional nbr
	movem	t2,c.dir	;store the direction
	move	t3,c.cmd	;get the command nr
	hlrz	t3,c.tab(t3)	;get the d.tab offset
	add	t3,t2		;add the direction
	type	<>
	outstr	d.tab(t3)	;display the direction literal
	type	<  8>		;display final spaces and restore cursor
	setom	i.path		;set flag indicating arrow was entered
	ret			;return to calling routine
 
vc.sen:	aos	(sp)
	caie	t1,""
	jrst	vc.sn1
	movsi	t3,-4
	came	t2,[exp "A","B","C","D"](t3)
	aobjn	t3,.-1
	skipl	t3
	ret
	move	t3,[exp 1, 2, 0, 0](t3)
	jrst	vc.sn2
vc.sn1:	trz	t2,1b30
	movsi	t3,-^d11
	came	t2,[exp "A","F","K","E","C","I","H","L","P","V","R"](t3)
	aobjn	t3,.-1
	skipl	t3
	ret
vc.sn2:	type	<>
	hrrz	t3,t3
	movem	t3,c.nbr1
	aos	c.cnt
	caile	t3,2
	jrst	vc.sn3
	imuli	t3,3
	outstr	[asciz/ALL       /
		  asciz/FEDERATION/
		  asciz/KLINGON   /](t3)
	jrst	vc.sn4
vc.sn3:	move	uot,t3
	subi	uot,3
	outstr	@o.name(uot)
vc.sn4:	sos	(sp)
	ret
 
vc.tab:	move	t3,i.char	;move the two command characters
	movsi	t4,-c.size	;get the command table size
	hll	t3,c.tab(t4)
	came	t3,c.tab(t4)	;in the table?
	aobjn	t4,.-2		;bump the pointer, try again
	jumpge	t4,.+3		;if not negative, it's not in the table
	hrrzm	t4,c.cmd	;not zero - save the command nbr
	aos	(sp)		;form the skip ret
	ret			;return to calling routine
 
vc.num:	aos	(sp)		;form skip return - assume not a number
	call	vc.ifn		;test numeric
	jrst	vc.sig		;not a number, try a sign
	sos	(sp)		;cancel the skip ret
	move	t3,i.pos	;get the column nbr
	camg	t3,i.max	;greater than max allowed?
	jrst	.+3		;no - continue
	type	<>		;yes - signal the error
	ret			;return to calling routine
	call	vpos		;position the cursor
	type	<>
	outchr	t2		;display the number
	type	<8>		;restore the cursor
	aos	i.pos		;increase the column nbr
	andi	t2,17		;convert ascii to binary nbr
	movei	t3,^d10		;set the multiplier
	imulm	t3,i.nbr	;multiply the work number
	addm	t2,i.nbr	;add the input number
	ret			;return to calling routine
 
vc.sig:	cain	t2,"-"		;minus sign?
	jrst	.+4		;yes - continue
	caie	t2,"+"		;plus sign?
	ret			;neither sign, ret
	setom	i.sign		;set sign word to -1
	setcmm	i.sign		;complement the sign
	move	t3,i.spos	;get column for sign
	call	vpos		;position the cursor
	movei	t3,"-"		;assume negative
	skipl	i.sign		;skip if valid assumption
	movei	t3," "		;wasn't negative after all, use space
	type	<>
	outchr	t3		;display the sign
	type	<8>		;restore the cursor
	sos	(sp)		;cancel the skip ret
	ret			;return to calling routine
 
vc.brk:	cain	t2,"."		;is the char a period?
	ret			;yes - ret
	cain	t1,^d9		;is the inte a tab?
	ret			;yes - ret
	caie	t1,0		;is the entry from the main keyboard?
	jrst	.+2		;no - can't be a break, then
	caie	t2," "		;is the character a space?
	aos	(sp)		;not a break - form skip ret
	ret			;return to calling program
 
vc.ifa:	trz	t2,1b30		;convert to uppercase
	cail	t2,"A"		;is this a letter?
	caile	t2,"Z"
	  ret		;not a letter
	aos	(sp)		;it's a letter - form skip ret
	ret			;it's out of range - no skip ret
 
vc.ifn:	cail	t2,"0"		;is this a number?
	caile	t2,"9"
	  ret		;not a number
	aos	(sp)		;it's a number - form a skip ret
	ret			;it's out of range - no skip ret
 
vcget:	call	vtget		;get input integer and character
	move	t1,c.inte	;load the integer
	move	t2,c.char	;load the character
	cain	t1,^d13		;execute key? (carriage ret)
	ret			;yes - normal ret
	aos	(sp)		;form skip return 1
	cain	t2,"?"		;help function?
	ret			;yes - skip return 1
	aos	(sp)		;form skip return 2
	cain	t2,^d127	;delete?
	ret			;yes - skip return 2
	aos	(sp)		;form skip return 3
	cain	t1,^d8		;backspace?
	ret			;yes - skip return 3
	cain	t2,","		;erase function? (same as backspace)
	ret			;yes - skip return 3
	aos	(sp)		;form skip return 4
	ret			;none of the above - skip return 4
 
 
;*****	SCANLD
 
SCANLD::
	call	scnclr
	movei	uot,217
	skipge	u.tab(uot)
	jrst	.+3
	came	uot,s.uot
	call	scntst
	sojge	uot,.-4
	ret
 
;*****	SCNTST
;
;	tests whether an object is in scan range.  if so, SCNUPD is
;	called (updating scan tables) and row.2 is set = to the row
;	containing the object
 
SCNTST::
	setzm	row.2
	skipg	o.relx(uot)	;object in front of us?
	  ret		;no - can't be in viewer
	movm	t1,o.elev(uot)	;object has a reasonable elevation?
	camle	t1,[0.404026226]
	  ret		;no
	movm	t1,o.bear(uot)	;object has a reasonable bearing?
	camle	t1,[1.625476800]
	  ret		;no
	fix	t1,o.rang(uot)
	caig	uot,117		;if the object isn't a star,
	caig	t1,^d2048	;  is it out of range?
	skipa			;no - it's in range
	  ret		;yes - it's out of range
	move	ap,o.elev(uot)	;compute the exact row
	call	fatan
	fmpr	rs,[14.32394488]
	move	row,[7.0]
	fsbr	row,rs
	fixr	row,row
	skiple	row
	caile	row,^d13
	  ret		;row not in viewer
	move	ap,o.bear(uot)	;compute the exact col
	call	fatan
	fmpr	rs,[35.80986218]
	fadr	rs,[41.0]
	fixr	col,rs
	cail	col,6
	caile	col,^d76
	  ret		;col not in view
	movem	row,row.2
	call	scnupd
	ret
 
;*****	SCNCLR
;
;	Zeroes out the scanner table and moves zero to s.max, the
;	number of elements in the table.
 
SCNCLR::
	move	t1,[scan.1,,scan.1+1]
	setzm	scan.1
	blt	t1,scan.1+^d289
	setzm	s.max
	ret
 
 
;*****	SCNUPD
;
;	Updates the scanner table.  Table is in ascending sequence
;	by row and descending sequence by range within row.  This
;	allows VIEWLD to process a row at a time.  Descending ranges
;	allow VIEWLD to overlay the character elements in the viewer
;	table; assures that closer objects will overlay farther objects.
;
;	Uses the following:
;		w.row	- row on which object will be displayed
;		w.col	- col on which the center of the object will display
;		w.rang	- range as a floating point nbr
;		w.id	- object id
;		w.uot	- object nr (universal object idx)
 
SCNUPD::
	setz	t1,		;t1 is the scan table index
	fix	t2,o.rang(uot)	;get the range
	aos	s.max		;incr the element count
sc.tst:	hrrz	t3,scan.1(t1)	;main loop - get a scanner element
	trz	t3,-1000	;mask everything but the row
	caml	t3,row		;scan row less than new object row?
	  jrst	.+3		;no - test same row
	jumpe	t3,sc.upd	;end of table? - if so, add to end
	aoja	t1,sc.tst	;try the next element
	came	t3,row		;is there another object on this row?
	jrst	sc.shf		;no - push the table and insert
	camg	t2,scan.2(t1)	;range greater than new range?
	aoja	t1,sc.tst	;no - try the next element
sc.shf:	move	t4,s.max	;get the (new) table size
	move	t3,scan.1-1(t4)	;shift the elements down one
	movem	t3,scan.1(t4)	;
	move	t3,scan.2-1(t4)	;shift the ranges also
	movem	t3,scan.2(t4)	;
	soj	t4,		;decr the table idx
	camle	t4,t1		;are we at the insertion point?
	jrst	.-6		;no - shift the next element
sc.upd:	hrrz	t3,uot		;update - get the uot idx (obj nr)
	hrrz	t4,col		;get the column
	lshc	t3,^d9		;shift t3 and t4 a quarter word left
	move	ap,u.tab(uot)	;get the u.tab word
	andi	ap,17		;mask everything but the uid
	ior	t3,ap		;insert the object id
	ior	t4,row		;insert the row
	hrl	t4,t3		;combine t3 with t4
	movem	t4,scan.1(t1)	;store in scan.1
	movem	t2,scan.2(t1)	;store the range in scan.2
	ret			;return to calling routine
 
;*****	SCNDEL
;
;	searches for an object uot in the scan tables and, if found,
;	deletes it.  if an object was found, its row is stored in
;	row.1.  if not found, row.1 will = 0.
 
SCNDEL::
	setzb	t1,row.1
scd.1:	skipn	scan.1(t1)	;search for the uot
	  ret		;not found
	hlrz	t2,scan.1(t1)
	lsh	t2,-^d9
	came	t2,uot
	  aoja	t1,scd.1
	hrrz	t2,scan.1(t1)
	trz	t2,-1000
	movem	t2,row.1
	sos	s.max
scd.2:	move	t2,scan.2+1(t1)	;close up the hole in the scan
	movem	t2,scan.2(t1)	;  table
	move	t2,scan.1+1(t1)
	movem	t2,scan.1(t1)
	skipe	t2
	  aoja	t1,scd.2
	ret
 
;*****	VIEWLD
;
;	loads the viewer table from the scan table
 
VIEWLD::
	push	sp,p1
	push	sp,p2
	setzm	v.mod
	setzm	v.row
	setzb	p1,row
	hrrz	p2,scan.1(p1)
	trz	p2,-1000
vwl.1:	aoj	row,
	call	vwrupd
	caige	row,^d13
	  jrst	vwl.1
	pop	sp,p2
	pop	sp,p1
	ret
 
;*****	VWRTST
;
;	updates two viewer rows.  intended specifically for the case
;	when an object moves.  row.1 is the 'old' row, most probably
;	set up by SCNDEL.  row.2 is the 'new' row, set up by SCNTST.
;	a row isn't processed if it equals zero.  also, if the new
;	row = the old row, it's not necessary to process the new row.
 
VWRTST::
	setzm	v.rset		;will be set to -1 if a char is displayed.
	skipn	row,row.1
	  jrst	vwt.1
	camn	row,t.row
	  call	tarupd
	move	row,row.1
	call	vwrchg
vwt.1:	skipe	row,row.2
	camn	row,row.1
	  jrst	vwt.2
	camn	row,t.row
	  call	tarupd
	move	row,row.2
	call	vwrchg
vwt.2:	skipe	v.rset		;any characters displayed?
	  type	<8>		;yes, reset the cursor position.
	ret
 
;*****	VWRCHG
;
;	changes a single viewer row after finding it in the scan
;	table.  different from VIEWLD, which loads all rows
 
VWRCHG::
	push	sp,p1
	push	sp,p2
	setzm	v.mod
	setzb	p1,v.row
vwc.1:	skipn	p2,scan.1(p1)
	  jrst	vwc.2
	hrrz	p2,p2
	trz	p2,-1000
	camge	p2,row
	  aoja	p1,vwc.1
vwc.2:	call	vwrupd
	pop	sp,p2
	pop	sp,p1
	ret
 
VWRUPD::
	came	row,t.row
	jrst	vwu.1
	call	vwrini
	camn	row,p2
	call	vwrrow
	call	vwrtar
	jrst	vwu.2
vwu.1:	came	row,p2
	jrst	vwu.3
	call	vwrini
	call	vwrrow
vwu.2:	skipl	v.flag
	jrst	.+3
	call	vwrins
	skipa
	call	vwrdsp
	jrst	vwu.4
vwu.3:	skipge	v.flag
	jrst	.+3
	call	vwrnul
	skipa
	call	vwrdel
vwu.4:	setzm	v.flag
	ret
 
;*****	VWRDEL
 
VWRDEL::
	call	vr.tst
	ret
	call	vr.ini
	setz	t3,
	aoj	col,
	idpb	t3,v.tptr
	caige	col,^d74
	jrst	.-3
	ret
 
VWRINI::
	move	t1,[v.wrk,,v.wrk+1]
	setzm	v.wrk

	blt	t1,v.wrk+^d13
	ret
 
VWRROW::
	move	t1,scan.2(p1)
	lsh	t1,-5
	cail	t1,100
	movei	t1,77
	trz	t1,7
	hlrz	t2,scan.1(p1)
	trz	t2,-10
	add	t1,t2
	hrrz	t2,v.obj(t1)
	trz	t2,-10
	cail	t2,7
	jrst	vr.nxt
	hrrz	t3,scan.1(p1)
	lsh	t3,-^d9
	sub	t3,t2
	soj	t3,
	adjbp	t3,v.wrkp
	movem	t3,v.wptr
	move	t2,v.obj(t1)
	lshc	t1,5
	andi	t1,37
	trnn	t1,37
	jrst	vr.nxt
	idpb	t1,v.wptr
	jrst	.-5
vr.nxt:	aoj	p1,
	hrrz	p2,scan.1(p1)
	trz	p2,-1000
	camn	p2,row
	jrst	vwrrow
	ret
 
VWRTAR::
	move	col,t.col
	cain	row,7
	caie	col,^d41
	skipa
	  ret
	cail	col,2
	caile	col,^d74
	  ret
	adjbp	col,v.wrkp
	ldb	t1,col
	tro	t1,40
	dpb	t1,col
	ret
 
VWRCLR::
	move	t1,[v.tab,,v.tab+1]
	setzm	v.tab
	blt	t1,v.tab+^d172
	ret
 
VWRINS::
	call	vr.tst
	ret
	call	vr.ini
	adjbp	t3,v.wrkp
	movem	t3,v.wptr
vi.nxt:	aoj	col,
	ildb	t2,v.wptr
	trz	t2,40
	idpb	t2,v.tptr
	caige	col,^d74
	jrst	vi.nxt
	ret
 
VWRDSP::
	call	vr.tst
	ret
	call	vr.ini
	adjbp	t3,v.wrkp
	movem	t3,v.wptr
vr.dsp:	aos	t1,col
	ildb	t2,v.wptr
	ildb	t3,v.tptr
	came	t2,t3
	call	vr.out
	caige	t1,^d74
	jrst	vr.dsp
	ret
 
vr.out:	setom	v.rset		;a char will be displayed, must reset later.
	call	vnextp
	dpb	t2,v.tptr
	setz	t4,
	trze	t2,40
	movei	t4,40
;;	dpb	t2,v.tptr
	hlrz	t3,v.elem(t2)
	jumpe	t3,.+4
	came	t3,v.mod
	outstr	v.mod(t3)
	movem	t3,v.mod
	hrrz	t3,v.elem(t2)
	caie	t4,0
	type	<>
	trne	t3,200
	jrst	vr.bri
vr.drk:	outchr	t3
	caie	t4,0
	type	<>
	ret
vr.bri:	type	<>
	outchr	t3
	type	<>
	ret
 
VWRNUL::
	call	vr.tst
	ret
	call	vr.ini
vr.nu1:	aoj	col,
	ildb	t3,v.tptr
	jumpe	t3,vr.nu2
	setz	t3,
	dpb	t3,v.tptr
	call	vnextp
	type	< >
	setom	v.rset		;will reset the cursor later.
vr.nu2:	caige	col,^d74
	jrst	vr.nu1
	ret
 
vr.tst:	move	t2,row
	caig	t2,1
	ret
	caig	t2,^d12
	aos	(sp)
	ret
 
vr.ini:	move	t3,row
	soj	t3,
	imuli	t3,^d78
	addi	t3,^d7
	adjbp	t3,v.tabp
	movem	t3,v.tptr
	movei	t3,7
	movem	t3,col
	ret
 
;*****	TARUPD
 
TARUPD::
	move	uot,t.uot
	jumpge	uot,tu.chg
	  move	row,t.row
	  move	col,t.col
	  ret
tu.chg:	fix	t1,o.rang(uot)
	caile	t1,^d1536
	  jrst	tu.brk
	call	conuot
	move	t1,b1
	movem	t1,t.bear
	move	t1,e1
	movem	t1,t.elev
	call	contrc
	movem	row,t.row
	movem	col,t.col
	setzm	t.view
	call	rctest
	  ret
	setom	t.view
	ret
tu.brk:	mspini
	msptyp	<target no longer locked>
	mspout
	setom	t.uot
	setzm	t.bear
	setzm	t.elev
	movei	row,7
	movei	col,^d41
	movem	row,t.row
	movem	col,t.col
	setom	t.view
	ret
 
;*****	TARDSP
;
;	Displays reverse-video blinking target at w.row and w.col.
 
TARDSP::
	setz	t1,		;t1 will flag a difference in position
	camn	row,t.row	;new row same as old?
	came	col,t.col	;new col same as old?
	  seto	t1,		;no - t1 < 0 implies difference
	move	t2,t.view	;get viewer flag (0 = not in view)
	jumpe	t2,td.tst	;if wasn't in view, skip
	jumpe	t1,td.tst	;if in view but same location, skip
	push	sp,row		;save new row and col
	push	sp,col		;
	move	row,t.row	;get old row and col
	move	col,t.col	;
	call	td.get		;get the character number from viewer table
	trz	t2,40
	dpb	t2,t3
	type	<>		;turn off blink and reverse
	call	td.dsp		;display the char as a normal character
	pop	sp,col		;retrieve new row and col
	pop	sp,row		;
td.tst:	setzm	t.view		;assume new target isn't in viewer
	cail	row,^d2		;test row
	caile	row,^d12	;  row must be between 2 and 12
	  jrst	td.sav
	cail	col,^d8		;test col
	caile	col,^d74	;  col must be tween 8 and 74
	  jrst	td.sav
	setom	t.view		;target in view, flip view flag
	call	td.get		;get the char nbr at this row and pos
	cain	row,7
	caie	col,^d41
	  jrst	[tro	t2,40
		 dpb	t2,t3
		 trz	t2,40
		 jrst	.+1]
	jumpn	t1,.+3		;different position for target?
	camn	t2,t.elem	;no - different element number?
	  jrst	td.sav		;no - don't bother to display it again
	type	<>	;turn on blink and reverse
	call	td.dsp		;display the new cursor
td.sav:	movem	row,t.row	;save the new target row and col
	movem	col,t.col	;
	movem	t2,t.elem	;save the char nbr that was displayed
	ret			;return to calling routine
 
td.get:	move	t3,row		;get target character from viewer table
	soj	t3,		;
	imuli	t3,^d78		;  offset = (78 * (row - 1)) + col
	add	t3,col		;
	adjbp	t3,v.tabp	;get and adjust viewer pointer
	ldb	t2,t3		;load the character number
	ret			;return to calling routine
 
td.dsp:	cain	row,^d7		;if target is at center of viewer
	caie	col,^d41	;  (row = 7 and col = 41)
	skipa			;  don't display
	  ret
	call	vtpos		;position the cursor
	hlrz	t3,v.elem(t2)	;get the mode of the element
	skipe	t2		;mode important?
	  outstr  v.mod(t3)	;yes - change the mode
	hrrz	t3,v.elem(t2)	;get the character
	trne	t3,200		;bold character?
	  type	<>		;yes - turn on increased intensity
	outchr	t3		;display the character
	trne	t3,200		;bold character?
	  type	<>		;yes - turn off intensity
	ret			;ret
 
 
;*****	VPOS
;
;	Positions the cursor on the 'status' line (row 16).
;	Assumes column nr in t3; t3 and t4 are destroyed.
 
VPOS::
	type	<[16;>		;start the positioning sequence
	idivi	t3,^d10		;divide by 10
	tro	t3,"0"		;convert tens to ascii
	tro	t4,"0"		;convert units to ascii
	caie	t3,"0"		;skip tens if zero
	outchr	t3		;display the tens digit
	outchr	t4		;display the units digit
	type	<H>		;end the sequence
	ret			;return to calling routine
 
;*****	VNEXTP
 
VNEXTP::
	came	row,v.row
	setzm	v.col
	skipg	v.col
	jrst	vnxt.1
	camg	col,v.col
	jrst	vnxt.1
	move	t3,col
	sub	t3,v.col
	soje	t3,vnxt.1+1
	type	<[>
	idivi	t3,^d10
	tro	t3,"0"
	tro	t4,"0"
	caie	t3,"0"
	outchr	t3
	outchr	t4
	type	<C>
	skipa
vnxt.1:	call	vtpos
	movem	row,v.row
	movem	col,v.col
	ret
 
;*****	VTPOS
;
;	Positions cursor at row and col.  Works for 2-digit row
;	and col.  Destroys t3 and t4.
 
VTPOS::
	type	<[>		;display start of sequence
	move	t3,row		;move the row
	idivi	t3,^d10		;divide by 10 (remainder is in t4)
	tro	t3,"0"		;convert tens to ascii
	tro	t4,"0"		;convert units to ascii
	caie	t3,"0"		;skip tens if zero
	outchr	t3		;display tens
	outchr	t4		;display units
	type	<;>		;display sequence delimiter
	move	t3,col		;move the col
	idivi	t3,^d10		;divide by 10 (remainder is in t4)
	tro	t3,"0"		;convert tens to ascii
	tro	t4,"0"		;convert units to ascii
	caie	t3,"0"		;skip tens if zero
	outchr	t3		;display tens
	outchr	t4		;display units
	type	<H>		;display final control sequence character
	ret			;ret
 
 
;*****	VTGET
;
;
;	Gets a character from the terminal, returns c.inte and
;	c.char as follows:
;
;	Normal entries:	0 in c.inte, character entered in c.char.
;	Control char:	ADE nbr in c.inte, space in c.char
;			(delete returns 127 in c.inte, space in c.char).
;	Keypad keys:	27 (escape) in c.inte, the following in c.char:
;			   up		A
;			   down		B
;			   right	C
;			   left		D
;			   pf1-4	A,B,D,C (note sequence)
;			   0-9		0-9
;			   comma	comma
;			   dash		dash
;			   period	period
;			   enter	M in c.char, 13 in c.inte (cr)
 
VTGET::
	call	vtimed		;get a character (timed interrupt)
	type	<8>
	andi	t4,177		;mask the last 8 bits
	setzm	c.inte		;zero the integer
	movei	t1," "		;move space to the char
	caige	t4," "		;is it a ctrl char? (less than space)
	jrst	vt.ctl		;yes
	caie	t4,177		;no - is it a delete?
	jrst	vt.chr		;no - it's just a normal character
	movem	t4,c.inte	;yes, a delete - move it to integer
	jrst	vt.sav		;go to ret
 
vt.ctl:	movem	t4,c.inte	;move to integer
	cain	t4,33		;is it an escape?
	jrst	vt.esc		;yes - assume an escape sequence
ife tops20,<
	cain	t4,15		;not an escape - is it a carriage ret?
	inchrw	t3		;yes - ignore the linefeed
>
	jrst	vt.sav		;go to ret
 
vt.esc:	inchrw	t4		;get the next esc sequence character
	andi	t4,177		;mask the last 8 bits
	cain	t4,"["		;is it a keypad sequence?
	jrst	vt.kpd		;yes - process it
	caie	t4,"O"		;an arrow?
	jrst	vt.chr		;no - don't know what it is
 				;yes - process the sequence
vt.kpd:	inchrw	t4		;get the next character
	andi	t4,177		;mask the last 8 bits
	caige	t4,"l"		;is it lowercase L or greater?
	jrst	vt.upr		;no - probably an uppercase letter
	caile	t4,"y"		;is it lowercase Y or less?
	jrst	vt.chr		;no - don't know what it is
	andi	t4,77		;make it a number or - , . character
	jrst	vt.chr		;go to ret
 
vt.upr:	caie	t4,"M"		;was it the ENTER key?
	jrst	vt.pf		;no - test the pf keys
	movei	t3,15		;generate a carriage ret
	movem	t3,c.inte	;move cr to integer
	jrst	vt.chr		;go to ret
 
vt.pf:	cain	t4,"P"		;is it pf1?
	movei	t4,"A"		;yes - convert to up arrow
	cain	t4,"Q"		;is it pf2?
	movei	t4,"B"		;yes - convert to down arrow
	cain	t4,"R"		;is it pf3?
	movei	t4,"D"		;yes - convert to left arrow
	cain	t4,"S"		;is it pf4? (if not, it's probably an arrow)
	movei	t4,"C"		;yes - convert to right arrow
vt.chr:	movem	t4,t1		;move t4 to t1
vt.sav:	movem	t1,c.char	;save the character
	ret			;return to calling routine
 
;*****	VTIMED
 
VTIMED::
	call	d.time
ife tops20,<
	seto	t1,
	wake	t1,
	  skip
	movsi	t1,1b32
	hrri	t1,^d500
	move	t2,t1
	hiber	t2,
	  skip
	hiber	t1,
	  skip
	inchrs	t4
	  jrst	[call	qtest
		 jrst	vtimed]
	ret
> 
ifn tops20,<
	movei	t1,.priin
	sibe
	 jrst	vtinp
	movei	t1,^d500
	disms
vtdsms:	movei	t1,.priin
	sibe				;input now?
	 jrst	vtinp
	call	qtest			;no - do q-processing
	jrst	vtimed

vtinp:	inchrw	t4
	ret

;***** ITYPIN - get typein interrupts

itypin:	save	t1
	hrrz	t1,lev2pc		;check interrupt PC
	caie	t1,vtdsms
	 jrst	itypix			;not waiting - exit
	movsi	t1,10000		;user mode flag
	iorm	t1,lev2pc		;debrk back to wakeup
itypix:	rest	t1
	debrk
>

ife tops20,<
d.time:
	mstime	t1,
	idiv	t1,[^d60000]
	idiv	t1,[^d60]
	came	t1,l.hr
	  pjrst	d.hour
	came	t2,l.mn
	  pjrst	d.min
	ret
 
d.hour:	movem	t1,l.hr
	movem	t2,l.mn
	type	<>
	call	d.out
	type	<:>
	move	t1,l.mn
	call	d.out
	type	<8>
	ret
 
d.min:	movem	t2,l.mn
	move	t1,t2
	type	<>
	call	d.out
	type	<8>
	ret
 
d.out:	idivi	t1,^d10
	addi	t1,"0"
	addi	t2,"0"
	outchr	t1
	outchr	t2
	ret
> 
ifn tops20,<
d.time:	sosle	d.tcnt
	 ret
	movei	t1,^d120	;call approx every 500ms
	movem	t1,d.tcnt
	type	<>
	movei	t1,.priou
	seto	t2,
	movx	t3,ot%nda!ot%nsc
	odtim
	type	<8>
	ret
>

;*****	DSPCON
;
;	Displays the TREK console.  Positions cursor in middle of view
;	screen and stores it.
 
DSPCON::
	call	clrscr		;clear the screen
	call	dspbri		;display the bright areas
	call	dspdrk		;display the dark areas
	call	dspdsp		;display the lower left area
	call	dsppad		;display the keypad area
	type	<(B7>
				;position the cursor at screen center
	ret			;ret
 
dspbri:	type	<(0>
	call	dspbr1
	call	dspbr2
	typec	<  16  16  >
	call	dspbr2
	typec	<   8  8   >
	call	dspbr2
	typec	<   0  0   >
	call	dspbr2
	typec	<   8  8   >
	call	dspbr2
	typec	<  16  16  >
	call	dspbr2
	call	dspbr3
	typec	<         >
	call	dspbr1
	movei	c,10
	typec	<     >
	sojg	c,.-1
	type	<>
	type	<                                                             >
	typec	< >
	call	dspbr3
	type	<         >
	ret
 
dspbr1:	type	<        >
	type	<48   40   32   24   16    8    0    8    16   24   32   40   48>
	typec	<        >
	ret
 
dspbr2:	typec	<          >
	ret
 
dspbr3:	type	<         >
	type	<                                                             >
	ret
 
dspdrk:	type	<>
	movei	c,5
	typec	<    >
	typec	< ~~ >
	sojg	c,.-2
	typec	<    >
	type	</ >
	type	</   ~    ~    ~    ~    ~    ~    ~    ~    ~    ~    ~    ~    ~   \>
	type	< \>
	type	<>
	movei	c,10
	typec	<  >
	sojg	c,.-1
	type	</                                                         \>
	ret
 
dspdsp:	type	<(0>
	typec	<lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqwqqqqwqqqqqqwqqqqqqk>
	type	<x ENERGY      x SHL         x WARP   >
	typec	<x                  x>
	typec	<tqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqvqqqqvqqqqqqvqqqqqqu>
	typec	<xx>
	typec	<xx>
	typec	<xx>
	typec	<xx>
	type	<mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj>
	ret
 
dsppad:	type	<(0>
	type	<lqqqwqqqwqqqwqqqk>
	type	<xMOVxROTxWRPxLISx>
	type	<tqqqnqqqnqqqnqqqu>
	type	<xTARxPHAxTORxERAx>
	type	<tqqqnqqqnqqqnqqqu>
	type	<xLOKxREFxSHLxEXEx>
	type	<tqqqvqqqnqqqu   x>
	type	<xLR SCANxMORx ` x>
	type	<mqqqqqqqvqqqvqqqj>
	ret

clrscr:	type	<=[?8h[?5;6;7l(B>
				;set VT100 characteristics:
				;  1;24r  set scrolling region to full screen
				;  =	turn on keypad
				;  8h	autorepeat on
				;  5l	white on black screen
				;  6l	absolute origin
				;  7l	no wraparound
				;  H	home the cursor
				;  J	clear the screen
				;  B	alphanumeric character set
	ret
 
;*****	VTEST
 
VTEST::
	skipn	vtflag
	aosa	(sp)
	typec	< >
	ret

 
;*****	VTINI
;
;	Call:	enter macro vtini using integer.
;
;	Initializes and tests the terminal.
 
VTINI::
;	trmchr	set,.tonfc,on
	call	ttyset
	call	initty
;;;;;	call	vttest
	SETZM	VTFLAG		;[BUDD]

ife tops20,<
	move	t1,[xwd -1,2]	;.GTPPN
	gettab	t1,
	skip
	camn	t1,[1106020002]
	ret
	came	t1,[452003562]
>
	skipe	vtflag
	jrst	vterr
	ret
 
 
;*****	VTTEST
;
;	Call:	enter macro vttest using integer.
;
;	Determines whether the terminal is a VT100 with advanced
;	video option.  Returns 0 if this is the case, returns -1
;	otherwise.
 
VTTEST::
	setom	vtflag		;assume not a VT100
	setzm	v52flg		; and not in vt52 mode
IFN TOPS20,<
	MOVEI	T1,.PRIIN	;PRIMARY INPUT
	GTTYP			;GET TYPE
	 ERJMP	VTERR
	CAIN	T1,.TT100	;VT100?
	 JRST	VT100		; YEP
	CAIE	T1,.TT125	;VT125?
	 CAIN 	T1,.TTK10	; OR VK100 == GIGI
	  JRST	VT100		;  YESSIR
	CAIE	T1,.TTV52	;VT52 (MIGHT BE IN COMPATIBILITY MODE)
	 JRST	VTERR		; NOPE
> ;IFN TOPS20
	type	<Z>		;ask terminal to identify itself
ife tops20,<
	mstime	t2,		;get the current time in msecs
	addi	t2,^d2000	;add 2000 msecs
	movem	t2,wtime	;save as end time
	jrst	vhiber		;jump to hiber
vwait:	mstime	t2,		;get the current time
	caml	t2,wtime	;less than the end time?
	ret			;no - error (time limited exceeded)
vhiber:	movsi	t1,(1b14)	;set wake on character ready
	iori	t1,^d2000	;set 2000 msec hiber time
	hiber	t1,		;hiber
	skip			;hiber error - abort
	inchrs	t3		;character ready?
	jrst	vwait		;no - test time limit
>
ifn tops20,<
	movei	t3,^d100	;wait 100 * 100ms = 10 sec
vwait:	movei	t1,^d100
	disms
	movei	t1,.priin
	sibe			;any input?
	 jrst	vident		;yes - get it
	sojle	t3,r		;return if timeout
	jrst	vwait		; else, continue

vident:	inchrw	t3		;return char in t3
>
	caie	t3,""		;is the character an escape?
	 ret			;no - error (id sequence begins w escape)
	inchrw	t3		;get the next id character
	cain	t3,"["		;is it a [?
	 jrst	vt100		;yes - assume a VT100
	caie	t3,"/"		;no - is it a /?
	 ret			;no - terminal is not a VT100
vt152:	inchrw	t3		;get the 3rd character
	caie	t3,"Z"		;is it a Z?
	 ret			;no - not a VT100 in VT52 mode
	setom	v52flg		;yes - remember that
IFN 1,<
	outstr	[asciz/</]	;>and change the mode to ANSI
vt100:	setzm	vtflag
ife tops20,<clrbfi>
ifn tops20,<
	movei	t1,.priin
	cfibf
> ;TOPS20
> ;IFN 1
IFN 0,<
	outstr	[asciz/<Z/]	; >and change the mode to ANSI
	inchrw	t3		;  and ask again for identification.
	inchrw	t3		;skip the 1st 2 characters
vt100:	inchrw	t3		;skip the ?
	inchrw	t3		;get the terminal id nbr
	caie	t3,"1"		;make sure it is a VT100
	 ret
	inchrw	t3		;skip the ;
	inchrw	t1		;get options
	inchrw	t3		;skip the final c
	trnn	t1,1b34		;advanced video?
	 outstr	[asciz /This VT100 does not have an advanced video option.
/]
> ;IFN 0
	setzm	vtflag		;clear flag (TTY is a VT100)
	ret			;ret
 
vterr:	typec	< >
	typec	< >
	typec	<Sorry, this program only runs on a VT100 with Advanced Video Option>
ife tops20,<
	exit
>
ifn tops20,<
	haltf
	jrst .-1
>
 
;*****	TTYSET
 
TTYSET::
ife tops20,<
	seto	t2,
	trmno.	t2,
	  ret
	move	c,[xwd 2,t1]
	movei	t1,1003
	trmop.	c,
	  skip
	movem	c,tolct
	move	c,[xwd 2,t1]
	movei	t1,1006
	trmop.	c,
	  skip
	movem	c,tofrm
	move	c,[xwd 2,t1]
	movei	t1,1010
	trmop.	c,
	  skip
	movem	c,tonfc
	move	c,[xwd 2,t1]
	movei	t1,1012
	trmop.	c,
	  skip
	movem	c,towid
	move	c,[xwd 3,t1]
	movei	t1,2003
	movei	t3,0
	trmop.	c,
	  skip
	movei	t1,2006
	movei	t3,1
	trmop.	c,
	  skip
	movei	t1,2010
	movei	t3,1
	trmop.	c,
	  skip
	movei	t1,2012
	movei	t3,210
	trmop.	c,
	  skip
	ret
>
ifn tops20,<
	movei	t1,.priou
	rfmod
	move	t2,savmod
	txz	t2,tt%eco!tt%dam
	sfmod
	ret
>


;*****	TTYRST
 
TTYRST::
	skipe	v52flg		;need to reset vt100 to vt52 mode?
	 outstr	[asciz /[?2l/]
	setzm	v52flg
ife tops20,<
	seto	t2,
	trmno.	t2,
	  skip
	move	c,[xwd 3,t1]
	movei	t1,2003
	move	t3,tolct
	trmop.	c,
	  skip
	movei	t1,2012
	move	t3,towid
	trmop.	c,
	  skip
	ret
>
ifn tops20,<
	movei	t1,.priou
	move	t2,savmod
	sfmod
	ret
>

;*****	INITTY
 
INITTY::
ife tops20,<
	open	ttychn,[xwd    0,700
			sixbit /TTY/
			xwd    0,0]
	  jrst	[typec<open error on tty channel>
		 exit	1,
		 exit]
>
	ret
 
 
;*****	FINTTY
 
FINTTY::
	call	ttyrst
ife tops20,<
	releas	ttychn,
	  skip
>
	ret			;return


ifn tops20,<
;code to generate shareable segment and .EXE file

MAKIT:	reset
IFN 0,<	hlre	t4,116		;first move symbols
	movns	t4
	addi	t4,exit.##+100	;end of FORLIB (I hope)
	hrlz	t3,116		;from loc
	hrri	t3,exit.##+100
	hrrm	t3,116		;adjust symbol pntr
	blt	t3,-1(t4)	;move 'em
	hrlzi	t3,0(t4)	;clear remainder of page
	hrri	t3,1(t4)
	setzm	0(t4)
	iori	t4,777
	blt	t3,0(t4)
	lsh	t4,-^d9
	move	uot,t4		;c(uot) := highest page to save
	move	t3,116		;search symbol table for PAT..
makit1:	move	t2,0(t3)
	tlz	t2,740000	;clear symbol type bits
	came	t2,[radix50 0,PAT..]
	 aobjn	t3,makit1
	jumpge	t3,makit2	;found?
	movei	t1,exit.##+1	;yes - new patch loc
	movem	t1,1(t3)
> ;IFN 0
makit2:	move	t3,[shrbeg,,shrbeg]
	blt	t3,shrend 
	setzm	shrend
	movei	t2,shrend
	iori	t2,777
	move	t3,[shrend,,shrend+1]
	blt	t3,0(t2)	;make pages private, etc...
	movx	t1,gj%fou!gj%sht
	hrroi	t2,[asciz /DSK:VTTREK.SHARE/]
	gtjfn
	 jrst	makerr
	movx	t2,of%wr
	openf
	 jrst	makerr
	hrlz	t2,t1
	move	t1,[.fhslf,,<shrbeg>_-^d9]
	movei	t3,<shrend_-^d9>-<shrbeg_-^d9>+1
	txo	t3,pm%cnt!pm%rd!pm%wr!pm%ex
	pmap
	hlrz	t1,t2		;get jfn back
	closf
	 jrst	makerr
	movei	t1,.fhslf
	move	t2,[3,,ev]
	sevec
	setom	bootf		;boot flag
	setzm	120
	setzm	121
	setzm	44		;clear this tops10 stuff
	movx	t1,gj%fou!gj%sht
	hrroi	t2,[asciz /DSK:VTTREK.EXE/]
	gtjfn
	 jrst	makerr
	hrli	t1,.fhslf
;;	movni	t2,1(uot)
;;	hrlzs	t2
	MOVSI	T2,-377		;[BUDD]
	txo	t2,ss%rd!ss%cpy!ss%exe
	setz	t3,
	ssave
	 erjmp	makerr
	hrroi	t1,[asciz /
Done...
/]
erdun:	psout
	haltf
	jrst	.-1

makerr:	hrroi	t1,[asciz /
? Error in MAKIT
/]
	jrst	erdun

vererr:	hrroi	t1,[asciz /
? Common segment and program versions don't match.
/]
	jrst	erdun

bterr:	hrroi	t1,[asciz /
? Access error for Common segment.
/]
	jrst	erdun

BOOTS::	aose	bootf
	 jrst	trek		;game already booted!
	move	t1,[.fhslf,,<trek>_-^d9]
	rmap
	hlrz	t2,t1
	setz	t4,
	hrroi	t1,tk.dev
	movx	t3,1b2
	jfns
	hrroi	t1,tk.dir
	movx	t3,1b5
	jfns
	hrroi	t1,tk.nam
	movx	t3,1b8
	jfns
	hrroi	t1,[asciz /SHARE/]
	movem	t1,gjblk+.gjext
	movx	t1,gj%old
	movem	t1,gjblk
	movei	t1,gjblk
	setz	t2,
	gtjfn
	 jrst	bterr
	movx	t2,of%rd!of%wr!of%thw!of%dud
	openf
	 jrst	bterr
	hrlzs	t1
	move	t2,[.fhslf,,<shrbeg>_-^d9]
	movei	t3,<shrend_-^d9>-<shrbeg_-^d9>+1
	txo	t3,pm%cnt!pm%rd!pm%wr!pm%ex
	pmap
	jrst	trek		;startup game...

	end	<1,,MAKIT>
> 
ife tops20,<	end	TREK>