;USR0:<BUDD>VTTREK.MAC.7 7-Mar-85 FM+1D.19H.44M.15S., by BUDD

;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 " Federation[26CKlingon Empire"
su.ln2: asciz " ----------[26C--------------"

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
ty 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 /[;5;7m[22;72HMOR8/] > define morclr < outstr [asciz /[m[22;72HMOR8/] > ;***** GETIME gets the mstime and compares it to the last mstime retrieved.
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,<
fine 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 /
/] 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
p,.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
t %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
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/[;7m[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 <[H[J> 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
e 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: ;
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
os (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]
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
ge 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
tr 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
ab(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
m 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 <[18;68HPHA[CTOR8> 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 <[18;68H[7mPHA[CTOR8> 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]
ovem 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
00 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 <[1m> movei t1,^d10 type <(1 [D(B> sojg t1,.-1 type <[m> 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[1m> 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)
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
9 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)
,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
ei 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
,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
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)
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
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::
lk 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 <[H[J> call stwait move c,u.tab(suot) tlz c,1b19 movem c,u.tab(suot) call wrapup gexit SLFTST:: type <[2;1y> movei t1,^d2000 call trwait jrst rfresh RFRESH:: call dspcon call enedsp call shldsp call wrpdsp skipe r.fire type <[18;68H[7mPHA[CTOR8> ife tops20,<setzm l.hr> ifn tops20,<setzm d.tcnt>
ll 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
ni 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
p 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
RSCN:: 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
xyz 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 <[16;39H> 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 <[16;13H>
,u.ener(suot) idivi t1,^d1000 call nbrdsp type <8> ret ;***** SHLDSP SHLDSP:: move suot,s.uot type <[16;24H> 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
0 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 <[;5;7m> hlrz t2,v.elem(ap) skipe t2 outstr v.mod(t2) hrrz t2,v.elem(ap) trne t2,200 jrst [type <[1m> outchr t2 type <[m> ret] outchr t2 trze t1,40 type <[m> 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::
d2048 call shptst
anet 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
0 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
kipn 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
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
im2] 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
emp 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
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 <[0;4q> 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 <[q> 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[1;7m> call flshbr type <[m> 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
flshld type <(B[1;7m> call flshbr type <[m> 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[;1m>
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 <[12;41H[2K[B[2K>
type <[2A[2K[3B[2K>
type <[4A[2K[5B[2K>
type <[6A[2K[7B[2K>
type <[8A[2K[9B[2K>
type <[10A[2K[11B[2K>
type <[12A[2K[13B[2K>
type <[14A[2K[15B[2K>
type <[16A[2K[17B[2K>
type <[18A[2K[19B[2K>
type <[20A[2K[21B[2K>
type <[22A[2K[23B[2K>
type <[;5m(B>
movei t1,[asciz /[12;9H#3/]
skipn c
movei t1,[asciz /[8;9H#3/]
outstr (t1)
outstr @o.name(suot)
type < Destroyed!>
movei t2,[asciz /[13;9H#4/]
skipn c
movei t2,[asciz /[9;9H#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 <[12;9H#3>
outstr (t1)
type < Defeated!>
type <[13;9H#4>
outstr (t1)
type < Defeated!>
type <[16;9H#3>
outstr (t2)
type < Victorious!>
type <[17;9H#4>
outstr (t2)
type < Victorious!>
jrst .+1]
type <[3B[m>
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 <[D [D>
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;41H7>
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 ap,evnt.a(p1) tlnn ap,1b27 pjrst phadsp pjrst phodsp phadsp: caig t2,^d1024 call rctest ret call vtpos type <[1;7m> movei t1,^d10 type <(B [D(B> sojg t1,.-1 type <[m> call getvwr call dspvwr type <(B[m> type <8> ret phodsp: movei c,flsh03 caile t2,^d512 movei c,flsh01 movem c,flsh.p call flshld type <B[1;7m> call flshbr type <[m> 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
nt.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)
b31 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 <[1;2;3;4q> type <[?5h[?5l> type <[?5h[?5l> type <[?5h[?5l> type <[?5h[?5l> type <[?5h[?5l[0q> 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>
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,
tc) 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)
uot(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
; ; 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
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
ipr 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
ISSION 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)
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]
e 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.
:: 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
t 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 <[H[JAll ships in play, try again later> setzm i.lock gexit] type <[H[J> 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: _[D7>
st set.g set.e: type <[D_[D> 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
t] 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 <[H[JThe > 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 <[H[JRe-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.
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
d300000] ; wrong (crash during startup) and jrst ilok.2 ; give player control immediately. type <[H[JStart-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 <[15C> move uot,t1 call su.usr seto t3, su.pl3: cail t2,7 jrst su.pl4 addi t2,2
4,u.tab(t2) tlnn t4,1b19 jrst su.pl3 outchr c type <[38C> outstr @o.name(t2) outchr c type <[51C> 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 <[38C> outstr @o.name(t2) jrst su.av1 su.av4: jumpn t3,su.av1 ret su.hed: crlf
tr 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 <[H[JEnter a tournament number from 1 to 9 > typec <to load a tournament game;> type <Enter any other character to load a random game: _[D7> 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
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?
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
dom 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::
s20,<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
.+1 ; in case user has disabled this move t1,[.ticti,,2] ;put typein on chl 2 ati > ret ;***** ICTRAP ICTRAP:: type <[H[J> 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 <[H[J> 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
ol-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[m> releas ttychn, skip > ifn tops20,< movei t1,.priin cfibf type <(B[m> > 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
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::
ll 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)
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
;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)
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 <[16;45H[7m 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
ne 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 <[16;43H[7m> ;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?
har type <[16;44H[7m> ;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 <[16;43H[7m 8> jrst vc.1st ;go back to 1st field vc.2bk: type <[16;47H[7m 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)
lp ;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?
ive 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 <[16;54H[7m 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
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
? 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 <[16;54H[7m 8> jrst vc.3rd ;go back to 3rd field vc.hlp: type <[16;45H[7m?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 <[16;43H[7m 8> jrst vc.1st ;go back to the beginning
ate 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 <[16;43H[7m> ;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 <[7m 8> ;clear and restore cursor ret ;return to calling routine
ol: 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 <[7m> outstr d.tab(t3) ;display the direction literal type < 8> ;display final spaces and restore cursor
ndicating 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 <[16;48H[7m> 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
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 <[7m> 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
type <[7m> 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
;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)
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
arther 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
3,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
em 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?
> ;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
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,
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 <[5;7m> trne t3,200 jrst vr.bri vr.drk: outchr t3 caie t4,0 type <[m> ret vr.bri: type <[1m> outchr t3 type <[m> 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
m 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 <[m> ;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
le 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 <[;5;7m> ;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
s 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 <[1m> ;yes - turn on increased intensity outchr t3 ;display the character trne t3,200 ;bold character? type <[m> ;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
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 ; ;
rminal, 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?
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?
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,
iv 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 <[1;7m[24;74H> call d.out type <:> move t1,l.mn call d.out type <8> ret d.min: movem t2,l.mn move t1,t2 type <[1;7m[24;77H> 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 <[1;7m[24;74H> 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 <(B[m[7;41H7> ;position the cursor at screen center ret ;ret dspbri: type <[H[;1;7m(0> call dspbr1
br2 typec <[C [C16 [67C 16[C > call dspbr2 typec <[C [C 8 [67C 8 [C > call dspbr2 typec <[C [C 0 [67C 0 [C > call dspbr2 typec <[C [C 8 [67C 8 [C > call dspbr2 typec <[C [C16 [67C 16[C > call dspbr2 call dspbr3 typec < > call dspbr1 movei c,10 typec <[C [57C [17C > sojg c,.-1 type <[C> type < > typec <[17C > call dspbr3 type < > ret dspbr1: type <[C > type <48 40 32 24 16 8 0 8 16 24 32 40 48> typec < > ret dspbr2: typec <[C [C [67C [C > ret dspbr3: type <[C > type < > ret dspdrk: type <[2;1H[;7m> movei c,5 typec <[2C [3C [67C [3C > typec <[2C [3C~[67C~[3C > sojg c,.-2 typec <[2C [3C [67C [3C > type <[2C/ [2C> type </ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ \> type <[2C \> type <[15;1H>
vei c,10 typec <[2C [57C > sojg c,.-1 type <[2C/ \>
ret

dspdsp: type <(0[15;4H>
typec <[mlqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqwqqqqwqqqqqqwqqqqqqk>
type <[3Cx ENERGY x SHL x WARP >
typec <x[7m [mx>
typec <[3Ctqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqvqqqqvqqqqqqvqqqqqqu>
typec <[3Cx[55Cx>
typec <[3Cx[55Cx>
typec <[3Cx[55Cx>
typec <[3Cx[55Cx>
type <[3Cmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj>
ret

dsppad: type <[m(0>
type <[15;63Hlqqqwqqqwqqqwqqqk>
type <[16;63HxMOVxROTxWRPxLISx>
type <[17;63Htqqqnqqqnqqqnqqqu>
type <[18;63HxTARxPHAxTORxERAx>
type <[19;63Htqqqnqqqnqqqnqqqu>
type <[20;63HxLOKxREFxSHLxEXEx>
type <[21;63Htqqqvqqqnqqqu x>
type <[22;63HxLR SCANxMORx ` x>
type <[23;63Hmqqqqqqqvqqqvqqqj>
ret

clrscr: type <[1;24r=[?8h[?5;6;7l[H[J(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>