Trailing-Edge
-
PDP-10 Archives
-
walsh_goodStuff_1600
-
more-games/vttrek.mac
There are no other files named vttrek.mac in the archive.
;<HESS>VTTREK.MAC.31 8-Jan-81 09:09:14, Edit by HESS
; 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==1> ;default to TOPS20
ifndef ftki10,<ftki10==0> ;Not KI10
title TREK
.request sys:forlib
sall
ife tops20,<
search UUOSYM
twoseg
>
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
ife tops20,<reloc 400K>
ifn tops20,<
loc 400K
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 /TREK/
lk.ext: sixbit /HLP/
0
lk.ppn: xwd 0,0
>
io.ptr: z
io.cnt: z
io.blk: block 13
z
;tty characteristics
ife tops20,<
tolct: z
tofrm: z
tonfc: z
towid: z
topag: z
>
opdef call [pushj p,]
opdef ret [popj p,]
opdef pjrst [jrst] ;replaces pushj/popj sequences
opdef retskp [jrst rskp]
;***** TYPE types an ascii string without a CRLF.
; TYPEC types an ascii string followed by a CRLF.
; CRLF types a CRLF.
define type (string)<
outstr [asciz $'string'$]
>
define typec (string)<
outstr [asciz $'string'
$]>
define crlf <
outstr [asciz $
$]>
;***** DSPTYP types an ascii string in the display area.
; MSPTYP types an ascii string on the message line.
define dsptyp (string)<
dspstr [asciz $'string'$]
>
define msptyp (string)<
mspstr [asciz $'string'$]
>
;***** MORDSP causes the MOR key to flash.
; MORCLR returns the MOR key to its normal state.
define mordsp <
outstr [asciz /[;5;7m[22;72HMOR8/]
>
define morclr <
outstr [asciz /[m[22;72HMOR8/]
>
;***** GETIME gets the mstime and compares it to the last mstime retrieved.
; if not greater, assume new day and subtract 24 hours.
ife tops20,<
define getime (ac)<
mstime ac,
camge ac,u.time(suot)
add ac,[^d86400000]
movem ac,u.time(suot)
>>
ifn tops20,<
define getime (ac)<
ifn ac-t1,<exch ac,t1>
save t2
time
movem t1,u.time(suot)
rest t2
ifn ac-t1,<exch t1,ac>
>>
;***** SAVE saves up to 10 registers.
; REST restores registers saved by SAVE.
define save (d0,d1,d2,d3,d4,d5,d6,d7,d8,d9)<
ifn d0,<push p,d0>
ifn d1,<push p,d1>
ifn d2,<push p,d2>
ifn d3,<push p,d3>
ifn d4,<push p,d4>
ifn d5,<push p,d5>
ifn d6,<push p,d6>
ifn d7,<push p,d7>
ifn d8,<push p,d8>
ifn d9,<push p,d9>
>
define rest (d0,d1,d2,d3,d4,d5,d6,d7,d8,d9)<
ifn d9,<pop p,d9>
ifn d8,<pop p,d8>
ifn d7,<pop p,d7>
ifn d6,<pop p,d6>
ifn d5,<pop p,d5>
ifn d4,<pop p,d4>
ifn d3,<pop p,d3>
ifn d2,<pop p,d2>
ifn d1,<pop p,d1>
ifn d0,<pop p,d0>
>
; TREK is a KL10 program. The following macro handles the ADJBP if
; the program is run on a KI. KL versions have REPEAT 0 preceding
; the macro, KI versions have REPEAT 1.
ifn ftki10,<
define adjbp (r,p)<
move rs,r
move r,p
ibp r
sojg rs,.-1
>>
ife tops20,<
define gexit <
exit 1,
exit
>>
ifn tops20,<
define gexit <
haltf
jrst trek
>>
; Displays in the 4-line display area and on the message line are
; performed using local UUOs. The DSP UUOs display in the display
; area. The MSP UUOs display on the message line.
loc 41
call uuoser
ife tops20,<
loc 137
byte (3)tk.who (9)tk.ver (6)tk.min (18)tk.edt
>
reloc
opdef dspini [1b8]
opdef dspchr [2b8]
opdef dspstr [3b8]
opdef dsppos [4b8]
opdef dspout [5b8]
opdef dspclr [6b8]
opdef dspimm [7b8]
opdef mspini [10b8]
opdef mspchr [11b8]
opdef mspstr [12b8]
opdef msppos [13b8]
opdef mspout [14b8]
opdef mspclr [15b8]
opdef mspimm [16b8]
ifn tops20,<
opdef inchrw [35b8]
opdef outchr [36b8]
opdef outstr [37b8]
>
uuoser: save ap
ldb ap,[point 9,.jbuuo,8]
jumpe ap,uuoerr
call @uuotab-1(ap)
rest ap
ret
uuoerr:
ife tops20,<
outstr [asciz /
? Illegal LUUO
/]
exit 1,
jrst .-1
>
ifn tops20,<
exch ap,t1
hrroi t1,[asciz /
? Illegal LUUO
/]
psout
exch t1,ap
haltf
jrst .-1
>
uuotab: %dsini
%dschr
%dsstr
%dspos
%dsout
%dsclr
%dsimm
%msini
%mschr
%msstr
%mspos
%msout
%msclr
%msimm
repeat <37-<.-uuotab>>,<uuoerr>
ifn tops20,<
reloc uuotab+34
.sichw
.sochr
.sostr
>
%dsini: push p,t1
hrrz ap,.jbuuo
move t1,[ascii / /]
skipn ap
jrst [movem t1,utxt.b
move t1,[xwd utxt.b,utxt.b+1]
blt t1,utxt.b+53
jrst %dsi.1]
sose ap
imuli ap,13
movem t1,utxt.b(ap)
hrri t1,utxt.b+1(ap)
hrli t1,utxt.b(ap)
blt t1,utxt.b+12(ap)
%dsi.1: move t1,[point 7,utxt.b]
add t1,ap
movem t1,.dpptr
movem t1,.dwptr
pop p,t1
ret
%dschr: hrrz ap,.jbuuo
move ap,(ap)
idpb ap,.dwptr
ret
%dsimm: hrrz ap,.jbuuo
move ap,(ap)
outchr ap
idpb ap,.dwptr
push p,t1
move t1,.dwptr
subi t1,54
dpb ap,t1
pop p,t1
ret
%dsstr: push p,t1
hrrz ap,.jbuuo
move t1,[point 7,0]
add t1,ap
%dss.1: ildb ap,t1
jumpe ap,%dss.2
idpb ap,.dwptr
jrst %dss.1
%dss.2: pop p,t1
ret
%dspos: hrrz ap,.jbuuo
soj ap,
adjbp ap,.dpptr
movem ap,.dwptr
ret
%dsout: push p,t1
push p,t2
push p,t3
push p,t4
push p,row
push p,col
hrrz ap,.jbuuo
skipn ap
jrst [movei ap,1
call %dso.1
movei ap,2
call %dso.1
movei ap,3
call %dso.1
movei ap,4
call %dso.1
jrst .+2]
call %dso.1
pop p,col
pop p,row
pop p,t4
pop p,t3
pop p,t2
pop p,t1
ret
%dso.1: move row,ap
addi row,^d17
sose ap
imuli ap,13
move t1,[point 7,utxt.a]
add t1,ap
movem t1,.dptra
move t1,[point 7,utxt.b]
add t1,ap
movem t1,.dptrb
movei col,6
setzm .dcol
%dso.2: ildb t1,.dptra
ildb t2,.dptrb
came t1,t2
call %dso.3
caige col,^d59
aoja col,%dso.2
skipe .dcol
outstr [asciz/8/]
ret
%dso.3: skipg .dcol
jrst %dso.4
camg col,.dcol
jrst %dso.4
move t3,col
sub t3,.dcol
soje t3,%dso.5
outstr [asciz/[/]
caie t3,1
call %dso.6
outstr [asciz/C/]
jrst %dso.5
%dso.4: outstr [asciz/[/]
move t3,row
call %dso.6
outstr [asciz/;/]
move t3,col
call %dso.6
outstr [asciz/H/]
%dso.5: outchr t2
dpb t2,.dptra
movem col,.dcol
ret
%dso.6: idivi t3,^d10
tro t3,"0"
tro t4,"0"
caie t3,"0"
outchr t3
outchr t4
ret
%dsclr: move ap,[ascii / /]
movem ap,utxt.a
move ap,[xwd utxt.a,utxt.a+1]
blt ap,utxt.a+127
ret
.dpptr: z ;permanent pointer
.dwptr: z ;working pointer
.dptra: z
.dptrb: z
.dcol: z
utxt.a: block 4*13
utxt.b: block 4*13
%msini: push p,t1
move t1,[ascii / /]
movem t1,mtxt.b
move t1,[xwd mtxt.b,mtxt.b+1]
blt t1,mtxt.b+12
%msi.1: move t1,[point 7,mtxt.b]
movem t1,.mpptr
movem t1,.mwptr
pop p,t1
ret
%mschr: hrrz ap,.jbuuo
move ap,(ap)
idpb ap,.mwptr
ret
%msimm: hrrz ap,.jbuuo
move ap,(ap)
outchr ap
idpb ap,.mwptr
push p,t1
move t1,.mwptr
subi t1,54
dpb ap,t1
pop p,t1
ret
%msstr: push p,t1
hrrz ap,.jbuuo
move t1,[point 7,0]
add t1,ap
%mss.1: ildb ap,t1
jumpe ap,%mss.2
idpb ap,.mwptr
jrst %mss.1
%mss.2: pop p,t1
ret
%mspos: hrrz ap,.jbuuo
soj ap,
adjbp ap,.mpptr
movem ap,.mwptr
ret
%msout: push p,t1
push p,t2
push p,t3
push p,t4
push p,row
push p,col
call %mso.1
pop p,col
pop p,row
pop p,t4
pop p,t3
pop p,t2
pop p,t1
ret
%mso.1: move t1,[point 7,mtxt.a]
movem t1,.mptra
move t1,[point 7,mtxt.b]
movem t1,.mptrb
movei col,6
setzm .mcol
%mso.2: ildb t1,.mptra
ildb t2,.mptrb
came t1,t2
call %mso.3
caige col,^d59
aoja col,%mso.2
skipe .mcol
outstr [asciz/8/]
ret
%mso.3: skipg .mcol
jrst %mso.4
camg col,.mcol
jrst %mso.4
move t3,col
sub t3,.mcol
soje t3,%mso.5
outstr [asciz/[/]
caie t3,1
call %mso.6
outstr [asciz/C/]
jrst %mso.5
%mso.4: outstr [asciz/[;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
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
jrst [skipe t.more
call @t.more
jrst trmain]
skipe t.more
jrst [setzm t.more
morclr
jrst .+1]
move ap,c.dir
cain ap,5
jrst [call help
jrst trmain]
jumpe t1,tr.cmd
tr.imm: skipe t.more
jrst [setzm t.more
morclr
jrst .+1]
call @[srscan
srscan
srscan
srscan
lrscan
rfphas
rfphot]-1(t1)
jrst trmain
tr.cmd: skipe t.more
jrst [setzm t.more
morclr
jrst .+1]
move t1,c.cmd
jumpe t1,trmain
call @[spec
tlock
refuel
shield
target
phaser
photon
motion
rotate
warp
dsplst
captur
trnsfr
bases
nearb
alibr
flibr
klibr
plibr
send
help
users
help
help
quit
quit
rfresh
slftst
rapfir
score
assist
ralert
yalert
salert
flibb
flibp
flibs
klibb
klibp
klibs
plibn]-1(t1)
jrst trmain
ife tops20,<reloc>
;***** SRSCAN
;
; short range sensor scan. search depends on the value of the
; immediate flag:
;
; i = fed, 2 = kli, 3 = planet, 4 = anything
SRSCAN::
call lstclr
skipe t.more
jrst [move uot,t.mor1
move ap,t.mor2
movem ap,c.imm
move ap,t.mor3
movem ap,s.mask
setzm t.more
morclr
jrst sr.mor]
seto uot,
hrrz t2,c.imm
caile t2,2
jrst sr.nxt
lsh t2,4
movem t2,s.mask
sr.nxt: call sscan
jrst sr.end
cail lst,4
jrst [movem uot,t.mor1
move ap,c.imm
movem ap,t.mor2
move ap,s.mask
movem ap,t.mor3
movei ap,srscan
movem ap,t.more
jrst sr.end]
sr.mor: aoj lst,
movem uot,luot.b(lst)
call catalg
jrst sr.nxt
sr.end: skipg lst
jrst [mspini
msptyp <nothing detected by short-range sensors>
mspout
ret]
move ap,[xwd luot.b,luot.a]
blt ap,luot.a+4
call lstout
skipe t.more
mordsp
ret
sscan: call stdscn
ret
fix ap,o.rang(uot)
caile ap,^d1024
jrst sscan
hrrz ap,c.imm
cain ap,3
jrst ss.hit
caie ap,4
jrst [hrrz ap,u.tab(uot)
xor ap,s.mask
trne ap,3b31
jrst sscan
jrst ss.hit]
caie t1,2
cain t1,7
skipa
jrst sscan
ss.hit: aos (p)
ret
LRSCAN::
call tarscn
jrst [mspini
msptyp <nothing detected by long-range sensors>
mspout
ret]
call lstclr
aoj lst,
movem uot,luot.b(lst)
call catalg
move ap,[xwd luot.b,luot.a]
blt ap,luot.a+4
dspini
call lstdsp
call lrshld
dspout
ret
LRSHLD::
move ap,u.tab(uot)
andi ap,17
caie ap,7
caig uot,17
skipa
ret
dspini 2
dsptyp < shields >
skiple t3,u.shld(uot)
jrst [dsptyp <UP >
idivi t3,^d1000
call nbrout
ret]
movm t3,t3
dsptyp <DN >
idivi t3,^d1000
call nbrout
dsptyp <, energy >
move t3,u.ener(uot)
idivi t3,^d1000
call nbrout
ret
SPEC::
skipn dbugf
; skipa
jrst [dspini
dsptyp <SPACE! The Final Frontier!>
dspout
ret]
call lstclr
skipe t.more
jrst [move uot,t.mor1
move ap,t.mor2
movem ap,c.nbr1
setzm t.more
morclr
jrst sp.mor]
seto uot,
sp.nxt: call getlib
jrst sp.end
cail lst,4
jrst [movem uot,t.mor1
move ap,c.nbr1
movem ap,t.mor2
movei ap,spec
movem ap,t.more
jrst sp.end]
sp.mor: aoj lst,
movem uot,luot.b(lst)
call catalg
jrst sp.nxt
sp.end: skipg lst
jrst [mspini
msptyp <not found>
mspout
ret]
move ap,[xwd luot.b,luot.a]
blt ap,luot.a+4
call lstout
skipe t.more
mordsp
ret
getlib: aoj uot,
caile uot,217
ret
camn uot,suot
jrst getlib
skipge t1,u.tab(uot)
jrst getlib
skipe c.nbr1
jrst [andi t1,17
came t1,c.nbr1
jrst getlib
jrst .+1]
aos (p)
ret
TLOCK::
call getobj
ret
fix t1,o.rang(uot)
caile t1,^d1024
jrst [mspini
msptyp <target object not within 1024 units>
mspout
ret]
movem uot,t.uot
call conuot
move t1,b1
movem t1,t.bear
move t1,e1
movem t1,t.elev
call contrc
call tardsp
type <8>
mspini
msptyp <target locked>
mspout
ret
SYNCH::
move t1,t.bear
movem t1,b1
move t1,t.elev
movem t1,e1
setzm t.bear
setzm t.elev
movei row,7
movei col,^d41
call tardsp
type <8>
call rot.zy
call obload
ret
SHIELD::
move t2,c.dir
caile t2,2
jrst shl.er
move t1,c.cnt
jumpe t1,shl.st
move t1,c.nbr1
caige t1,0
jrst shl.er
imuli t1,^d1000
movem t1,f.data
movm t2,u.shld(suot)
sub t1,t2
call enetst
ret
move t1,f.data
skipa
shl.st: movm t1,u.shld(suot)
move t2,c.dir
caig t2,0
skipl u.shld(suot)
cain t2,2
movn t1,t1
movem t1,u.shld(suot)
call shldsp
ret
shl.er: type <>
ret
TARGET::
setom t.uot
move t1,c.cnt
move t2,c.dir
jrst @[ta.c0
ta.c1
ta.c2](t1)
ret
ta.c0: call tarfnd
skip
ret
ta.00: mspini
msptyp <target reset>
mspout
setzm t.bear
setzm t.elev
call contrc
call tardsp
ret
ta.c1: fltr t3,c.nbr1
jrst @[ta.d0
ta.d1
ta.d2
ta.d3
ta.d4](t2)
ret
ta.d0: jumpe t3,ta.00
call getlst
ret
move t3,b1
movem t3,t.bear
move t3,e1
movem t3,t.elev
call contrc
call tardsp
ret
ta.d1: move t4,t.elev
fadr t4,t3
jrst ta.d21
ta.d2: move t4,t.elev
fsbr t4,t3
ta.d21: movem t4,t.elev
jrst ta.dd
ta.d3: move t4,t.bear
fadr t4,t3
jrst ta.d41
ta.d4: move t4,t.bear
fsbr t4,t3
ta.d41: movem t4,t.bear
ta.dd: call contrc
call tardsp
ret
ta.c2: fltr t3,c.nbr1
movem t3,t.bear
fltr t3,c.nbr2
movem t3,t.elev
call contrc
call tardsp
ret
TRNSFR::
movei t1,^d200
skipe c.cnt
move t1,c.nbr1
caile t1,0
caile t1,^d1000
jrst [type <>
ret]
movem t1,p.ener
imul t1,t1
movem t1,p.time
move t1,p.ener
imuli t1,^d1000
skiple u.shld(suot)
jrst [mspini
mspstr @o.name(suot)
msptyp < shields are up>
mspout
ret]
call enetst
ret
move t1,p.time
idivi t1,^d100
caige t1,^d2000
movei t1,^d2000
movem t1,p.time
setz t2,
call pflash
call tarscn
jrst trs.wt
fixr t1,o.rang(uot)
caile t1,^d1024
jrst trs.wt
movem t1,eadd.t
move t1,p.ener
call eneadd
caile uot,7
jrst trs.wt
movei t1,2000
lsh t1,@uot
ior t1,suot
hrli t1,10
movsm t1,eadd.a
movem uot,eadd.b
call lqadd
trs.wt: move t1,p.time
pjrst trwait
SCORE::
setzm n.nuot
move c,[xwd n.nuot,n.nuot+1]
blt c,n.nuot+7
movei t1,120
sco.1: sojl t1,sco.3
skipge c,u.tab(t1)
jrst sco.1
andi c,17
cail c,7
jrst sco.1
caie c,2
jrst sco.2
move t2,u.tab(t1)
trne t2,@ally.n
jrst sco.1
trne t2,@ally.f
soj c,
sco.2: aos n.nuot(c)
jrst sco.1
sco.3: save p1,p2,p3
dspini 1
dsptyp <Active status:>
dspini 2
dsptyp < Federation:>
move p1,n.nuot+5
move p2,n.nuot+3
move p3,n.nuot+1
call sco.4
dspini 3
dsptyp < Klingon Empire:>
move p1,n.nuot+6
move p2,n.nuot+4
move p3,n.nuot+2
call sco.4
dspini 4
dspout
rest p1,p2,p3
ret
sco.4: dsppos ^d20
move t1,p1
call nbrfix
dsptyp < ship>
caie p1,1
dsptyp <s>
dsppos ^d31
move t1,p2
call nbrfix
dsptyp < base>
caie p2,1
dsptyp <s>
dsppos ^d42
move t1,p3
call nbrfix
dsptyp < planet>
caie p3,1
dsptyp <s>
ret
ASSIST::
setz t1,
call alerts
mspini
msptyp <assistance requested>
mspout
ret
RALERT::
movei t1,1
call alerts
mspini
msptyp <RED ALERT>
mspout
ret
YALERT::
movei t1,2
call alerts
mspini
msptyp <YELLOW ALERT>
mspout
ret
SALERT::
movei t1,3
call alerts
mspini
msptyp <secure from alert>
mspout
ret
ALERTS::
move uot,suot
move c,mask.u
movem c,s.mask
pjrst alert
ALERT::
movei t2,2000
lsh t2,@uot
movei t3,sh.mx
alr.1: camn t3,uot
jrst alr.2
andcam t2,u.alrt(t3)
caig t1,1
iorm t2,u.alrt(t3)
alr.2: sojge t3,alr.1
hrlz c,t1
hrr c,uot
movem c,eadd.b
move c,s.mask
trz c,@t2
hrli c,12
movsm c,eadd.a
setzm eadd.t
pjrst lqins
RAPFIR::
mspini
skipn c.nbr1
skipe c.nbr2
skipa
jrst [setzm r.fire
msptyp <weapons in normal mode>
mspout
type <[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]
movem t1,p.ener
imul t1,t1
movem t1,p.time
call enetst
ret
move t1,p.time
idivi t1,^d75
caige t1,^d3000
movei t1,^d3000
movem t1,p.time
setz t2, ;weapons code (phaser = 0)
call pflash
call tarscn
jrst pha.wt
fixr t1,o.rang(uot)
caile t1,^d1024
jrst pha.wt
setz t2, ;weapons code (phaser = 0)
call pqadd
pha.wt: move t1,p.time
pjrst trwait
RFPHOT::
push p,c.cnt
push p,c.nbr1
move c,rf.pho
movem c,c.nbr1
movei c,1
movem c,c.cnt
call photon
pop p,c.nbr1
pop p,c.cnt
ret
PHOTON::
movei t1,1
skipe c.cnt
move t1,c.nbr1
cail t1,1
caile t1,3
jrst [type <>
ret]
camle t1,u.torp(suot)
jrst [mspini
msptyp <insufficient torpedos for burst>
mspout
ret]
movem t1,p.save
imuli t1,^d40000
call enetst
ret
movei t1,^d200
movem t1,p.ener
pho.sr: sos u.torp(suot)
hrrzi t2,1b27 ;weapons code (photon = 1)
call pflash
call tarscn
jrst pho.wt
fixr t1,o.rang(uot)
addi t1,^d2000
hrrzi t2,1b27 ;weapons code (photon = 1)
call pqadd
pho.wt: movei t1,^d2000
call trwait
sosle p.save
jrst pho.sr
ret
;***** PFLASH
PFLASH::
ior t2,mask.o
hrli t2,4 ;weapons fire event code
movsm t2,eadd.a
movem suot,eadd.b
setzm eadd.t
push sp,t2
call lqadd
pop sp,t2
trnn t2,1b27
pjrst pha.fl
pjrst pho.fl
pha.fl: move row,t.row
move col,t.col
call rctest
ret
call vtpos
type <[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)
movem t1,eadd.z
pjrst lqadd
MOTION::
move t2,c.dir
caie t2,3
cain t2,4
jrst rolshp
move t3,s.warp
move t2,c.cnt
cain t2,2
jrst mot.a
caie t2,1
jrst mot.t
skipe c.dir
jrst mot.b
mot.ls: call getlst
ret
call rot.zy
jrst mot.c
mot.b: skipl t3,c.nbr1
caile t3,^d9
jrst [type <>
ret]
jrst mot.c
mot.a: fltr t1,c.nbr1
movem t1,b1
fltr t1,c.nbr2
movem t1,e1
call rot.zy
jrst mot.c
mot.t: skipn c.dir
call rottar
mot.c: move t1,wf.tab(t3)
movem t1,f.data
move t2,c.dir
cain t2,2
movnm t1,f.data
imul t1,t1
call enetst
pjrst obload
call movshp
hrlz t1,mask.o
hrri t1,1 ;movement event code
movem t1,eadd.a
movem suot,eadd.b
setzm eadd.t
call hqadd
call obload
pjrst ifnear
movshp: fltr t1,f.data
fmpr t1,s.11
fadrm t1,u.absx(suot)
fltr t1,f.data
fmpr t1,s.12
fadrm t1,u.absy(suot)
fltr t1,f.data
fmpr t1,s.13
fadrm t1,u.absz(suot)
ret
rolshp: skipg c.cnt
ret
move t1,c.nbr1
cain t2,3
movn t1,c.nbr1
fltr t1,t1
call sincos
call rot.x
call obload
ret
IFNEAR::
seto uot,
ifnr.1: call stdscn
ret
caile t1,4 ;test only bases and planets
jrst ifnr.1
move ap,u.tab(uot)
trnn ap,3b31 ;test if neutral
jrst ifnr.1 ;don't perturb neutral entities
setz t1,
fix ap,o.rang(uot)
caig ap,^d1024
call tqins
jrst ifnr.1
ROTATE::
skipg t1,c.cnt
jrst rot.d
cain t1,2
jrst rot.2
skipg t2,c.dir
jrst rot.ls
move t1,c.nbr1
caie t2,2
cain t2,4
movn t1,t1
fltr t1,t1
call sincos
movei c,rot.z
caig t2,2
movei c,rot.y
call @c
pjrst obload
rot.ls: call getlst
ret
call rot.zy
pjrst obload
rot.d: skipg t2,c.dir
jrst rot.t
call tarfnd
ret
rot.t: call rottar
pjrst obload
rot.2: fltr t1,c.nbr1
movem t1,b1
fltr t1,c.nbr2
movem t1,e1
call rot.zy
pjrst obload
ROTTAR::
move t1,t.bear
movem t1,b1
move t1,t.elev
movem t1,e1
call rot.zy
setzm t.bear
setzm t.elev
movei row,7
movem row,t.row
movei col,^d41
movem col,t.col
ret
WARP::
skipn t1,c.cnt
jrst wrp.ds
move t2,c.nbr1
caige t2,0
jrst wrp.er
caile t2,^d9
jrst wrp.er
caie t1,2
jrst wrp.ex
move t3,c.nbr2
caige t3,0
jrst wrp.er
caile t3,^d1000
jrst wrp.er
movem t3,wf.tab(t2)
wrp.ex: movem t2,s.warp
call wrpdsp
ret
wrp.ds: dspini 1
dsptyp <Warp distances:>
dspini 2
dsptyp < w0:>
move t1,wf.tab
call nbrfix
dsptyp < w1:>
move t1,wf.tab+1
call nbrfix
dsptyp < w2:>
move t1,wf.tab+2
call nbrfix
dsptyp < w3:>
move t1,wf.tab+3
call nbrfix
dsptyp < w4:>
move t1,wf.tab+4
call nbrfix
dspini 3
dsptyp < w5:>
move t1,wf.tab+5
call nbrfix
dsptyp < w6:>
move t1,wf.tab+6
call nbrfix
dsptyp < w7:>
move t1,wf.tab+7
call nbrfix
dsptyp < w8:>
move t1,wf.tab+8
call nbrfix
dsptyp < w9:>
move t1,wf.tab+9
call nbrfix
dspini 4
dspout
ret
wrp.er: type <>
ret
ret
DSPLST::
skipe t1,c.nbr1
pjrst dspany
movei lst,4
skipl luot.a(lst)
pjrst lstout
sojg lst,.-2
mspini
msptyp <object list is empty>
mspout
ret
DSPANY::
cail t1,1
caile t1,30
jrst [type <>
ret]
move uot,o.nbr-1(t1)
skipl c,u.tab(uot)
trnn c,@mask.c
jrst [mspini
msptyp <nothing found by library computer>
mspout
ret]
call lstclr
aoj lst,
movem uot,luot.b(lst)
move c,[xwd luot.b,luot.a]
blt c,luot.a+4
pjrst lstout
CAPTUR::
call getobj
ret
hrrz t2,u.tab(uot)
andi t2,7
caie t2,2
jrst ca.np
move t2,o.rang(uot)
camle t2,[512.0]
jrst ca.re
move t2,u.tab(uot)
tlne t2,100
jrst ca.up
move t2,u.tab(uot)
trz t2,7b31
ior t2,ally.u
movem t2,u.tab(uot)
call catalg
mspini
msptyp <planet captured>
mspout
call rebtim
movem t1,rebel(uot)
ret
ca.np: call ca.id
msptyp < is not a planet>
mspout
ret
ca.re: call ca.id
msptyp < is not within 512 units>
mspout
ret
ca.id: mspini
jumpe t1,[msptyp <target object>
ret]
msptyp <object >
tro t1,"0"
mspchr t1
ret
ca.up: setz t1,
call tqins
mspini
msptyp <planetary defenses are up>
mspout
ret
REFUEL::
movei uot,7
call nscanp
jrst ref.er
camle t3,[512.0]
jrst ref.er
move t1,suot
move t2,uot
call reener
call enedsp
movei t1,^d1500
pjrst trwait
ref.er: mspini
msptyp <not within 512 units of a base>
mspout
ret
;***** REENER
;
; refuels ship T1 from base (or planet) T2.
REENER::
save t2
move t2,u.tab(t2)
andi t2,17
move c,u.torp(t1)
addi c,3
caie t2,2
addi c,2
caile c,^d10
movei c,^d10
movem c,u.torp(t1)
move c,[^d250000]
caie t2,2
add c,c
addb c,u.ener(t1)
movm t2,u.shld(t1)
add c,t2
camle c,[^d5000000]
jrst [move c,[^d5000000]
sub c,t2
movem c,u.ener(t1)
jrst .+1]
rest t2
ret
NEARB::
call lstclr
movei uot,7
call nscanb
jrst nrb.2
aoj lst,
movem uot,luot.b(lst)
nrb.2: movei uot,17
call nscanp
jrst nrb.3
aoj lst,
movem uot,luot.b(lst)
nrb.3: skipg lst
jrst [mspini
msptyp <nothing found by library computer>
mspout
ret]
move ap,[xwd luot.b,luot.a]
blt ap,luot.a+4
call lstout
ret
NSCANB: movei t2,17 ;don't include planets
skipa
NSCANP: movei t2,117
setzb t3,t4
nsc.1: aoj uot,
camle uot,t2
jrst nsc.2
skipge t1,u.tab(uot)
jrst nsc.1
andi t1,17
move c,ally.u
caie t1,7
tdnn c,u.tab(uot)
jrst nsc.1
jumpe t3,nsc.11
camg t3,o.rang(uot)
jrst nsc.1
nsc.11: move t3,o.rang(uot)
move t4,uot
jrst nsc.1
nsc.2: skipe uot,t4
aos (p)
ret
PLIBN:: move c,ally.n
movem c,s.mask
skipa
PLIBR:: setzm s.mask
setzm s.muid
movei uot,17
pjrst libscn
ALIBR:: seto uot,
setzm s.mask
setzm s.muid
pjrst libscn
FLIBB:: movei c,3
jrst flib
FLIBP:: movei c,2
jrst flib
FLIBS:: movei c,5
jrst flib
FLIBR:: setz c,
FLIB:: movem c,s.muid
move c,ally.f
movem c,s.mask
seto uot,
pjrst libscn
KLIBB:: movei c,4
jrst klib
KLIBP:: movei c,2
jrst klib
KLIBS:: movei c,6
jrst klib
KLIBR:: setz c,
KLIB:: movem c,s.muid
move c,ally.k
movem c,s.mask
seto uot,
pjrst libscn
BASES::
move c,ally.u
movem c,s.mask
setzm s.muid
movei uot,7
pjrst libscn
SEND::
move t1,c.nbr1
caig t1,2
jrst send.1
move uot,t1
subi uot,3
skipge u.tab(uot)
jrst sen.na
send.1: movei row,^d21
movem row,m.row
call getmsg
ret
call movmsg
move t2,c.nbr1
cail t2,3
jrst [movei t1,200
lsh t1,@t2
jrst send.2]
move t1,@[mask.a
mask.f
mask.k](t2)
trz t1,@mask.c
send.2: hrli t1,3 ;message event code
movsm t1,eadd.a
movem suot,eadd.b
setzm eadd.t
pjrst lqadd
sen.na: mspini
mspstr @o.name(uot)
msptyp < not available>
mspout
ret
MOVMSG::
push sp,t1
push sp,t2
move t1,suot
imuli t1,^d11
addi t1,u.msg
move t2,t1
hrli t1,m.msg
blt t1,^d10(t2)
pop sp,t2
pop sp,t1
ret
USERS::
call lstclr
skipe t.more
jrst [move uot,t.mor1
setzm t.more
morclr
jrst usr.mr]
movei uot,10
usr.nx: sojl uot,usr.en
skipl c,u.tab(uot)
tlnn c,1b19
jrst usr.nx
cail lst,4
jrst [movem uot,t.mor1
movei ap,users
movem ap,t.more
jrst usr.en]
usr.mr: aoj lst,
movem uot,luot.b(lst)
jrst usr.nx
usr.en: skipg lst
jrst [mspini
msptyp <no ships in play>
mspout
ret]
dspini
usr.ot: skipl uot,luot.b(lst)
call usrout
sojg lst,usr.ot
dspout
skipe t.more
mordsp
ret
USROUT::
dspini (lst)
dspstr @o.name(uot)
dsppos ^d16
ife tops20,<
move t4,u.tty(uot)
call sixout
dsptyp < >
move t4,u.nam1(uot)
call sixout
move t4,u.nam2(uot)
call sixout
dsptyp < >
move t4,u.ppn(uot)
call ppnout
>
ifn tops20,<
dsptyp <TTY>
move t2,u.tty(uot)
call octout
dsptyp < >
hrroi t1,io.blk
move t2,u.namx(uot)
dirst
jfcl
dspstr io.blk
>
ret
ife tops20,<
SIXOUT::
movei t1,6
setz t3,
lshc t3,6
addi t3,40
dspchr t3
sojg t1,.-4
ret
PPNOUT::
dsptyp <[>
hlrz t2,t4
call octout
dsptyp <,>
hrrz t2,t4
call octout
dsptyp <]>
ret
>
OCTOUT::
idivi t2,10
push p,t3
skipe t2
call octout
pop p,t3
addi t3,"0"
dspchr t3
ret
HELP::
dspini
skipe t.more
jrst [setzb t3,t.more
morclr
jrst hlp.m]
call closin
call openin
jrst hlp.nf
move t3,c.cmd
hrrz t3,c.tab(t3)
hlp.1: call readin
jrst hlp.nf
move t1,[point 7,io.blk]
ildb t2,t1
hlp.2: caie t2,"."
jrst hlp.1
ildb ap,t1
lsh ap,7
ildb t2,t1
cail t2,"A"
caile t2,"Z"
jrst [iori ap," "
jrst hlp.21]
ior ap,t2
ildb t2,t1
hlp.21: came ap,t3
jrst hlp.2
setz t3,
hlp.3: call readin
jrst hlp.4
move t1,[point 7,io.blk]
ildb t2,t1
cain t2,"."
jrst hlp.4
cail t3,4
jrst [movei ap,help
movem ap,t.more
dspout
mordsp
ret]
hlp.m: aoj t3,
dspini (t3)
dspstr io.blk
jrst hlp.3
hlp.4: dspout
call closin
ret
hlp.nf: mspini
msptyp <no help available>
mspout
ret
OPENIN::
ife tops20,<
move c,[sixbit /TREK/]
movem c,lk.nam
move c,[sixbit /HLP/]
movem c,lk.ext
skipe dbugf
jrst op.1
move ap,[xwd -1,135] ;get run device
gettab ap,
skipa
movem ap,op.dev
move ap,[xwd -1,136] ;get run ppn
gettab ap,
skipa
movem ap,lk.ppn
op.1: open hlpchn,op.blk
ret
lookup hlpchn,lk.blk
ret
setzm in.cnt
retskp
>
ifn tops20,<
save t1,t2
hrroi t1,[asciz /HLP/]
movem t1,gjblk+.gjext
setz t2,
movei t1,gjblk
gtjfn
jrst openix
movem t1,hlpjfn
movx t2,7b5+of%rd
openf
jrst [move t1,hlpjfn
rljfn
jfcl
jrst openix]
aos -2(p) ;skip return
openix: pop p,t2
pop p,t1
ret
>
READIN::
setzm io.blk
move ap,[xwd io.blk,io.blk+1]
blt ap,io.blk+12
move ap,[point 7,io.blk]
movem ap,io.ptr
setzm io.cnt
rd.1:
ifn tops20,<
move t1,hlpjfn
bin
erjmp closin
cain t2,15
jrst rd.1
cain t2,12
retskp
idpb t2,io.ptr
>
ife tops20,<
sosle in.cnt
jrst rd.2
in hlpchn,in.lst
jrst [movei ap,1200
movem ap,in.cnt
move ap,[point 7,in.blk]
movem ap,in.ptr
jrst rd.2]
ret
rd.2: ildb ap,in.ptr
skipg ap
jrst [call closin
ret]
cain ap,15
jrst rd.1
cain ap,12
retskp
idpb ap,io.ptr
>
aos io.cnt
jrst rd.1
CLOSIN::
ife tops20,<
close hlpchn,
releas hlpchn,
>
ifn tops20,<
save t1
move t1,hlpjfn
closf
jfcl
setzm hlpjfn
rest t1
>
ret
QUIT::
type <[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>
call d.time
call vwrclr
call obload
dspclr
mspclr
ret
;***** STDSCN
;
; scans for active objects, skips stars and our ship. returns
; uot in uot and uid in t1. uot must be initialized to 1 less
; than the 1st u.tab entry to be scanned. in most cases, this
; value is -1. if object is found, skip return is taken.
STDSCN::
aoj uot,
caile uot,117
ret
camn uot,suot
jrst stdscn
skipge t1,u.tab(uot)
jrst stdscn
hrrz t1,t1
andi t1,17
aos (sp)
ret
;***** LIBSCN
LIBSCN::
call lstclr
skipe t.more
jrst [move uot,t.mor1
move ap,t.mor2
movem ap,s.mask
setzm t.more
morclr
jrst lb.mor]
lb.nxt: call lbscn
jrst lb.end
skipn s.mask
jrst lb.sc1
trnn t1,@s.mask
jrst lb.nxt
lb.sc1: skipn s.muid
jrst lb.sc2
andi t1,17
came t1,s.muid
jrst lb.nxt
lb.sc2: cail lst,4
jrst [movem uot,t.mor1
move ap,s.mask
movem ap,t.mor2
movei ap,libscn
movem ap,t.more
jrst lb.end]
lb.mor: aoj lst,
movem uot,luot.b(lst)
jrst lb.nxt
lb.end: skipg lst
jrst [mspini
msptyp <nothing found by library computer>
mspout
ret]
move ap,[xwd luot.b,luot.a]
blt ap,luot.a+4
call lstout
skipe t.more
mordsp
ret
lbscn: aoj uot,
caile uot,117
ret
camn uot,suot
jrst lbscn
skipge t1,u.tab(uot)
jrst lbscn
trnn t1,@mask.c
jrst lbscn
aos (p)
ret
;***** GETOBJ
GETOBJ::
skipe c.dir
jrst go.er
skipe t1,c.cnt
jrst go.lst
call tarscn
jrst [mspini
msptyp <no object found at target coordinates>
mspout
ret]
setz t1,
aos (p)
ret
go.lst: caie t1,1
jrst go.er
call getlst
skipa
aos (p)
ret
go.er: type <>
ret
;***** TARFND
TARFND::
save p1,p2,p3,p4
movei p1,^d13
movei p2,1
movei p3,7
movei p4,^d75
camle p1,t.row
caml p2,t.row
jrst tf.nul
camle p4,t.col
caml p3,t.col
jrst tf.nul
cain t2,1
move p1,t.row
cain t2,2
move p2,t.row
cain t2,3
move p3,t.col
cain t2,4
move p4,t.col
movem p1,t.rmax
movem p2,t.rmin
movem p3,t.cmin
movem p4,t.cmax
call tartst
jrst tf.nul
call contrc
call tardsp
type <8>
rest p1,p2,p3,p4
aos (sp)
ret
tf.nul: mspini
msptyp <target not obtained>
mspout
rest p1,p2,p3,p4
ret
;***** TARTST
TARTST::
setz t3,
setob uot,f.hit
tt.nxt: aoj uot,
hrrz t1,scan.1(uot)
jumpe t1,tt.end
trz t1,-1000
camle t1,t.rmin
caml t1,t.rmax
jrst tt.nxt
hrrz t2,scan.1(uot)
lsh t2,-^d9
camle t2,t.cmin
caml t2,t.cmax
jrst tt.nxt
came t1,t.row
jrst .+3
camn t2,t.col
jrst tt.nxt
move t4,t1
soj t4,
imuli t4,^d78
add t4,t2
adjbp t4,v.tabp
ldb t4,t4
trz t4,40
cain t4,0
jrst tt.nxt
push sp,uot
hlrz uot,scan.1(uot)
lsh uot,-^d9
call conuot
move t1,b1
fsbr t1,t.bear
fmpr t1,t1
move t2,e1
fsbr t2,t.elev
fmpr t2,t2
fadr t1,t2
movem t1,f.data
movei ap,f.loc
call sqrt.##
pop sp,uot
jumpe t3,tt.n1
camg t3,rs
jrst tt.nxt
tt.n1: move t3,rs
move t1,b1
movem t1,w.bear
move t1,e1
movem t1,w.elev
setzm f.hit
jrst tt.nxt
tt.end: skipge f.hit
ret
move t1,w.bear
movem t1,t.bear
move t1,w.elev
movem t1,t.elev
aos (sp)
ret
;***** TARSCN
TARSCN::
push sp,p1
push sp,p2
push sp,p3
push sp,p4
move p1,t.bear
fsbr p1,[0.9]
move p2,t.bear
fadr p2,[0.9]
move p3,t.elev
fsbr p3,[2.1]
move p4,t.elev
fadr p4,[2.1]
setzb t3,t4
setob uot,f.hit
ts.nxt: call rngscn
jrst ts.end
call conuot
camg p1,b1
camge p2,b1
jrst ts.nxt
camg p3,e1
camge p4,e1
jrst ts.nxt
jumpe t3,ts.n1
camg t3,o.rang(uot)
jrst ts.nxt
ts.n1: move t3,o.rang(uot)
move t4,uot
setzm f.hit
jrst ts.nxt
ts.end: pop sp,p4
pop sp,p3
pop sp,p2
pop sp,p1
movem t4,uot
skipl f.hit
aos (sp)
ret
;***** RNGSCN
RNGSCN::
aoj uot,
caile uot,217
ret
camn uot,suot
jrst rngscn
skipge u.tab(uot)
jrst rngscn
fixr ap,o.rang(uot)
caile ap,^d2048
jrst rngscn
aos (p)
ret
;***** GETLST
GETLST::
move t1,c.cnt
caile t1,1
jrst gl.er
skipl t1,c.nbr1
caile t1,4
jrst gl.er
skipg t1
movei t1,1
skipge uot,luot.a(t1)
jrst [mspini
msptyp <list entry >
tro t1,"0"
mspchr t1
msptyp < is empty>
mspout
ret]
push p,t1
call lstxyz
call rbecmp
call conang
pop p,t1
aos (p)
ret
gl.er: type <>
ret
;***** LSTCLR
LSTCLR::
setom luot.b
move ap,[xwd luot.b,luot.b+1]
blt ap,luot.b+4
setz lst,
ret
;***** CATALG
CATALG::
caig uot,7
jrst [move c,ally.t
tdnn c,u.tab(uot)
ret
move c,u.absx(uot)
movem c,u.lstx(uot)
move c,u.absy(uot)
movem c,u.lsty(uot)
move c,u.absz(uot)
movem c,u.lstz(uot)
jrst cat.1]
move c,u.tab(uot)
andi c,17
caie c,7
cain c,1
ret
cat.1: move c,mask.u
iorm c,u.tab(uot)
ret
;***** LSTOUT
LSTOUT::
dspini
movei lst,1
skipl luot.a(lst)
call lstdsp
caige lst,4
aoja lst,.-3
dspout
ret
;***** LSTDSP
LSTDSP::
dspini (lst)
move t1,lst
tro t1,"0"
dspchr t1
dsptyp < >
move uot,luot.a(lst)
skipge t2,u.tab(uot)
ret
hrrz t2,t2
andi t2,7
cain t2,2 ;test for planet
jrst [hrrz t3,u.tab(uot)
andi t3,3b31
lsh t3,-4
move t3,p.name(t3)
movem t3,u.name+6
jrst .+1]
movei t3,3
imul t3,t2
dspstr u.name(t3)
caie t2,1 ;test for star
cain t2,7 ;test for interceptor
jrst ldsp.1
dspstr @o.name(uot)
ldsp.1: dsppos ^d35
call lstxyz
call rbecmp
call conang
fixr t1,b1
call nbrfix
dsptyp <b >
fixr t1,e1
call nbrfix
dsptyp <e >
fixr t1,r1
caile t1,^d9999
jrst [idivi t1,^d1000
call nbrfix
dsptyp <E3r>
ret]
dsptyp < >
call nbrfix
dsptyp <r>
ret
;***** LSTXYZ
LSTXYZ::
move c,ally.t
caig uot,7
tdnn c,u.tab(uot)
jrst lxyz.1
push p,u.lstx(uot)
push p,u.lsty(uot)
push p,u.lstz(uot)
jrst lxyz.2
lxyz.1: push p,u.absx(uot)
push p,u.absy(uot)
push p,u.absz(uot)
lxyz.2: pop p,z1
pop p,y1
pop p,x1
ret
;***** WRPDSP
WRPDSP::
type <[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>
move t1,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
ms.out: idivi t3,^d10
push sp,t4
skipe t3
call ms.out
pop sp,t4
addi t4,"0"
mspchr t4
ret
;***** FLTDSP
FLTDSP::
idivi t1,^d1000
push sp,t2
setz t3,
idivi t1,^d10
push sp,t2
aoj t3,
jumpg t1,.-3
pop sp,t2
tro t2,"0"
mspchr t2
sojg t3,.-3
msptyp <.>
pop sp,t1
idivi t1,^d10
push sp,t2
aoj t3,
caige t3,3
jrst .-4
pop sp,t2
tro t2,"0"
mspchr t2
sojg t3,.-3
ret
;***** GETVWR
GETVWR::
move t1,row
soj t1,
imuli t1,^d78
add t1,col
adjbp t1,v.tabp
ldb t1,t1
ret
;***** DSPVWR
DSPVWR::
move ap,t1
trze ap,40
type <[;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::
movei t1,^d2048
call shptst
jrst sb.nsh ;no ship in range
sb.tst: move c,u.tab(uot)
caile t2,^d1024
jrst [call sb.st
skip
movei t1,^d6000
pjrst tqins]
tlne c,1b27
jrst sb.att
caile t2,^d512
jrst [tlnn c,1b26
call detins
jrst sb.hib]
save t1,uot
call attins
rest t1,uot
sb.att: call autpha
sb.hib: movei t1,^d3000
pjrst tqins
sb.nsh: move c,u.tab(uot) ;no ship in range
tlz c,3b27
movem c,u.tab(uot)
call sb.st
ret
movei t1,^d6000
pjrst tqins
sb.st: move c,u.ener(uot)
caml c,[^d5000K]
jrst sb.et
addi c,^d150K
camle c,[^d5000K]
move c,[^d5000K]
movem c,u.ener(uot)
aos (p)
ret
sb.et: move c,u.shld(uot)
caml c,[^d5000K]
ret
addi c,^d150K
camle c,[^d5000K]
move c,[^d5000K]
movem c,u.shld(uot)
aos (p)
ret
;***** PLANET
;
; planet routine. responsible for launching and retrieving interceptors.
;
; planet uot's are a multiple of 4, ie the last 3 bits are 0. the
; planet's three interceptors immediately follow the planet and have
; uot's equal to the planet uot plus 1, 2, or 3.
;
; if a planet uot is known, the interceptor uot's are also known.
; if an interceptor uot is known, the planet's uot can be found by
; changing the last 3 bits of the interceptor uot to 0. a number
; of routines depend on this relationship.
PLANET::
movsi t1,1b29
iorm t1,u.tab(uot)
movei t1,^d2048
call shptst
jrst pl.nsh ;no ship in range
move c,u.tab(uot)
caile t2,^d1024
jrst [tlnn c,1b26
call detins
pjrst pl.reb]
save uot
tlnn c,1b27
call attins
rest uot
move t1,u.tab(uot)
tlne t1,7
jrst pl.lch
tlne t1,70
jrst [movei t1,^d3000
pjrst tqadd]
tlz t1,100
tlo t1,7
movem t1,u.tab(uot)
movei t1,^d15000
pjrst tqadd
pl.nsh: move t1,u.tab(uot)
tlne t1,70
jrst pl.get
tlon t1,1
jrst pl.nsx
tlon t1,2
jrst pl.nsx
tlon t1,4
jrst pl.nsx
tlz t1,3b27
movem t1,u.tab(uot)
pjrst pl.reb
pl.nsx: movem t1,u.tab(uot)
movei t1,^d10000
pjrst tqadd
pl.get: move t2,uot
movsi t3,1
tlze t1,10
jrst pl.gt1
aoj t2,
movsi t3,2
tlze t1,20
jrst pl.gt1
aoj t2,
movsi t3,4
tlz t1,40
pl.gt1: aoj t2,
ior t1,t3
movem t1,u.tab(uot)
move t3,u.tab(t2)
tlo t3,1b18
movem t3,u.tab(t2)
setzm time.q(t2)
movei t1,^d5000
call tqadd
hrlz t1,mask.a
hrri t1,2 ;delete object event code
movem t1,eadd.a
movem t2,eadd.b
setzm eadd.t
pjrst lqins
pl.lch: move t2,uot
movsi t3,10
tlze t1,1
jrst pl.lc1
aoj t2,
movsi t3,20
tlze t1,2
jrst pl.lc1
aoj t2,
movsi t3,40
tlz t1,4
pl.lc1: aoj t2,
ior t1,t3
movem t1,u.tab(uot)
move t3,u.tab(t2)
andi t1,7b31
trz t3,7b31
ior t3,t1
tlz t3,1b18
move t1,ui.e7
movem t1,u.ener(t2)
move t1,ui.s7
movem t1,u.shld(t2)
movem t3,u.tab(t2)
move uot,t2
movei t1,^d500
call tqadd
trz uot,3
movei t1,^d3000
call tqadd
ret
pl.reb:
call pl.shp
jrst pl.rb2
getime t1
camge t1,rebel(uot)
ret
movei c,100
movem c,ran.mx
setzm ran.mn
call random
trne t1,1
pjrst rebins
call rebtim
movem t1,rebel(uot)
pl.rb2: movei t1,^d3000
pjrst tqins
pl.shp: move t1,u.tab(uot)
andi t1,3b31
skipn t1
ret
lsh t1,-5
aos (p)
pl.sh1: move t2,u.absx(uot)
fsbr t2,u.absx(t1)
fmpr t2,t2
move c,u.absy(uot)
fsbr c,u.absy(t1)
fmpr c,c
fadr t2,c
move c,u.absz(uot)
fsbr c,u.absz(t1)
fmpr c,c
fadr t2,c
camg t2,[4000000] ;1024*1024
ret
addi t1,2
caig t1,sh.mx
jrst pl.sh1
sos (p)
ret
;***** INTERC
INTERC::
call int.mv
call int.ta
ret
INT.MV:
move t1,uot ;interceptor uot
move t2,t1
trz t1,3 ;form planet uot
andi t2,3 ;form coordinate key
move t3,@[u.absz(t1)
u.absx(t1)
u.absx(t1)]-1(t2)
move t4,@[u.absy(t1)
u.absz(t1)
u.absy(t1)]-1(t2)
hlrz t1,u.tab(uot)
andi t1,17
fadr t3,a.fact(t1)
fadr t4,b.fact(t1)
movem t3,@[u.absz(uot)
u.absx(uot)
u.absx(uot)]-1(t2)
movem t4,@[u.absy(uot)
u.absz(uot)
u.absy(uot)]-1(t2)
aoj t1,
caile t1,17
setz t1,
movs c,u.tab(uot)
trz c,17
ior c,t1
movsm c,u.tab(uot)
movei t1,^d2000
call tqadd
hrlz c,mask.a
hrri c,1 ;movement event code
movem c,eadd.a
movem uot,eadd.b
setzm eadd.t
pjrst lqins
INT.TA:
hlrz t1,u.tab(uot)
andi t1,360
lsh t1,-4
cail t1,6
seto t1,
aoj t1,
lsh t1,4
movs t2,u.tab(uot)
trz t2,360
ior t2,t1
movsm t2,u.tab(uot)
trne t1,360
ret
movei t1,^d1024
call shptst
ret ;no ship in range
call autpha
ret
;***** DETINS
DETINS::
move c,u.tab(uot)
tlo c,1b26
movem c,u.tab(uot)
trnn c,3b31
ret
trne c,1b31
jrst [hrrz c,mask.f
jrst .+2]
hrrz c,mask.k
ior c,uot
hrli c,11
movsm c,eadd.a
hrrzm t1,eadd.b
setzm eadd.t
pjrst lqins
;***** ATTINS
ATTINS::
move c,u.tab(uot)
tlo c,3b27
movem c,u.tab(uot)
trnn c,3b31
ret
trne c,1b31
jrst [hrrz c,mask.f
jrst .+2]
hrrz c,mask.k
tro c,1b27
ior c,uot
hrli c,11
movsm c,eadd.a
hrrzm t1,eadd.b
setzm eadd.t
pjrst lqins
REBTIM::
getime t1
addi t1,^d10000
move t2,u.tab(uot)
andi t2,3b31
movei t3,pl.mx
rtim1: skipge c,u.tab(t3)
jrst rtim2
andi c,3b31
came c,t2
jrst rtim2
move c,u.tab(t3)
andi c,17
cain c,2
jrst [addi t1,^d10000
jrst rtim2]
caie c,3
cain c,4
addi t1,^d30000
rtim2: soj t3,
cail t3,sb.mn
jrst rtim1
ret
REBINS::
move c,u.tab(uot)
trne c,1b31
jrst [hrrz c,mask.f
jrst .+2]
hrrz c,mask.k
hrli c,13
movsm c,eadd.a
hrrzm uot,eadd.b
setzm eadd.t
move c,u.tab(uot)
trz c,3b31
tro c,1b29
movem c,u.tab(uot)
pjrst lqins
;***** SHPTST
;
; Test for nearest ship within a given range of an object. T1 = test
; range. UOT = object uot. Non-skip return and T1 < 0 if no ship
; is in range. Skip return and T1 = ship uot if a ship is in range.
; Range is in T2. If object is neutral all ships are tested,
; otherwise only enemy ships are tested.
SHPTST::
imul t1,t1 ;square the distance
fltr t4,t1 ;t4 is the distance to beat
hrrz c,u.tab(uot) ;get the uot's u.tab word
andi c,3b31 ;mask everything but the alliance field
skipe c ;zero means neutral
trc c,3b31 ;the complement is the enemy
movem c,s.mask ;save either neutral (0) or enemy mask
movei t1,117 ;test ships and interceptors
setom f.uot ;temp storage if any ship passes the tests
spt.lp: came t1,uot
skipge t2,u.tab(t1) ;active ship?
jrst spt.nx ;no - skip it
trnn t2,3b31 ;neutral?
jrst spt.nx ;yes - skip it
move c,t2 ;going to look for a ship or an interceptor
andi c,17
cail c,3 ;ship uids are 5 and 6
caile c,7 ;interceptor uid is 7
jrst spt.nx ;neither a ship nor an interceptor
skipe s.mask ;if the mask isn't zero,
jrst [xor t2,s.mask ;xor it with u.tab word;
trne t2,3b31 ;if zero, the ship is an enemy,
jrst spt.nx ;if not zero, it's a friend
jrst spt.rn] ;it's an enemy
spt.rn: move t3,u.absx(uot) ;compute range ** 2 = (x1 - x2) ** 2
fsbr t3,u.absx(t1)
fmpr t3,t3 ;if any intermediate square is greater than
camle t3,t4 ; the squared least distance
jrst spt.nx ; the ship is not nearest or is out of range.
move c,u.absy(uot)
fsbr c,u.absy(t1)
fmpr c,c
camle c,t4 ;test the y distance
jrst spt.nx
fadr t3,c
move c,u.absz(uot)
fsbr c,u.absz(t1)
fmpr c,c
camle c,t4 ;test the z distance
jrst spt.nx
fadr t3,c
camle t3,t4 ;test the total distance
jrst spt.nx ;ship is not closest or is out of range
movem t3,t4 ;store the new least distance
movem t1,f.uot ;save the ship's uot
spt.nx: sojge t1,spt.lp
skipge t1,f.uot ;f.uot < 0 means no target found.
ret
movem t4,f.data
movei c,f.loc
save t1
call sqrt.##
fixr t2,rs
rest t1
aos (p)
ret
;***** FLSHLD
FLSHLD::
save p1,p2
move p1,flsh.p
setz t4,
call flins
fll.1: skipn p2,(p1)
jrst fll.2
hlrz p2,p2
trze p2,1b18
aoja row,.+3
trze p2,1b19
soj row,
sub col,p2
hrrz p2,(p1)
call flins
sojg p2,.-1
aoja p1,fll.1
fll.2: setzm flsh.t(t4)
rest p1,p2
ret
flins: call rctest
jrst fli.1
call getvwr
move t3,col
lsh t3,^d9
ior t3,row
hrl t3,t1
movem t3,flsh.t(t4)
aoj t4,
fli.1: aoj col,
ret
;***** FLSHBR
FLSHBR::
save p1
setzb p1,v.row
flb.1: skipn row,flsh.t(p1)
jrst flb.2
move col,row
lsh col,-^d9
andi row,777
andi col,777
call vnextp
type < >
aoja p1,flb.1
flb.2: rest p1
ret
;***** FLSHCH
FLSHCH::
save p1
setzb p1,v.row
flc.1: skipn row,flsh.t(p1)
jrst flc.2
hlrz t1,row
move col,row
lsh col,-^d9
andi row,777
andi col,777
call vnextp
call dspvwr
aoja p1,flc.1
flc.2: rest p1
ret
;***** TRWAIT
TRWAIT::
type <[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
call 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 t2,ap
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
hrrm ap,evnt.a(p1)
came uot,suot
jrst hr.oth
hr.us: hlrz ap,evnt.a(p1)
andi ap,377
skipge u.tab(ap)
ret
call hittst
ret
hlrz t1,evnt.b(p1)
call enedel
call hitus
movm ap,u.shld(uot)
add ap,u.ener(uot)
skipl ap
jrst [call hitmsg
pjrst hitchg]
aos evnt.a(p1)
call hitchg
jrst zapped
hr.oth: skipge u.tab(uot)
ret
hlrz t1,evnt.b(p1)
call enedel
movm ap,u.shld(uot)
add ap,u.ener(uot)
skipl ap
jrst [call attack
call hitack
pjrst hitchg]
call dstroy
hlrz ap,evnt.a(p1)
andi ap,377
camn ap,suot
jrst [setom t.uot
setzm t.bear
setzm t.elev
call contrc
call tardsp
jrst .+1]
call hitdst
aos evnt.a(p1)
pjrst hitchg
HITCHG::
move c,evnt.a(p1)
tlo c,@mask.a
and c,mask.q
tlz c,@mask.c
tlne c,@mask.a
movem c,evnt.a(p1)
ret
ATTACK::
hrrz c,u.tab(uot)
andi c,17
caie c,7
cain c,2
jrst att.pl
caie c,3
cain c,4
jrst [call att.ms
jrst att.ex]
ret
att.pl: save uot
trz uot,3
call att.ms
hlrz c,evnt.a(p1)
andi c,377
move c,u.tab(c)
trnn c,3b31
jrst [rest uot
jrst att.ex]
andi c,3b31
trc c,3b31
movem c,s.mask
att.p1: move c,u.tab(uot)
trz c,3b31
ior c,s.mask
movem c,u.tab(uot)
aoj uot,
trne uot,3
jrst att.p1
rest uot
att.ex: movei t1,^d2000
call tqins
ret
att.ms: movei c,1b18
move t1,u.tab(uot)
tlon t1,3b28
iorm c,evnt.a(p1)
movem t1,u.tab(uot)
ret
HITTST::
move t1,u.absx(uot)
fsbr t1,evnt.x(p1)
fmpr t1,t1
camle t1,[4096.0]
ret
move c,u.absy(uot)
fsbr c,evnt.y(p1)
fmpr c,c
fadrm c,t1
camle t1,[4096.0]
ret
move c,u.absz(uot)
fsbr c,evnt.z(p1)
fmpr c,c
fadrm ap,t1
camg t1,[4096.0]
aos (p)
ret
HITUS::
type <[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>
msptyp < secure from alert>](c)
mspout
ret
;***** STSHIP
;
; these routines control the activities of unmanned ships. ship
; behavior is governed by a set of 'missions'.
STSHIP::
call asetup
call nrload
hrrz t4,n.mssn(uot)
jrst @[stsh.0
stsh.1
stsh.2
stsh.2
stsh.2
stsh.2](t4)
stsh.0: call ai.ref
ret
jrst stsh.3
stsh.1: call ac.ref
ret
jrst stsh.3
stsh.2: call ai.ref
ret
call @[ac.esh
ac.eba
ac.cap
ac.hlp]-2(t4)
ret
stsh.3: call ai.esh
ret
call ai.hlp
ret
call ai.eba
ret
call ai.cap
ret
pjrst au.sea
;***** ASETUP
;
; sets up us-them masks for this ship.
ASETUP::
movei c,1
dmove t1,mask.f
tdne c,uot
exch t1,t2
dmovem t1,mska.u
dmove t1,ally.f
tdne c,uot
exch t1,t2
dmovem t1,alya.u
movm c,u.shld(uot)
add c,u.ener(uot)
movem c,n.ener
movei t1,^d50
pjrst salloc
;***** NRLOAD
;
; builds a table of ranges from this ship for all non-star objects.
; saves the uot and range of the nearest object of a class (planet,
; fed base, kli base, etc) and of the nearest neu, fed, and kli
; planet. also catalogs objects within 1024 units (short range
; scan function).
NRLOAD::
save p1,p2,p3
setom n.rang
move c,[xwd n.rang,n.rang+1]
blt c,n.rang+117
setom n.nuot
move c,[xwd n.nuot,n.nuot+1]
blt c,n.nuot+7
seto c,
tlz c,1b18
movem c,n.nran
move c,[xwd n.nran,n.nran+1]
blt c,n.nran+7
setzm n.pcnt
setzm n.scnt
move t1,u.absx(uot)
move t2,u.absy(uot)
move t3,u.absz(uot)
movei t4,117
nrl.1: skipl p2,u.tab(t4)
camn t4,uot
jrst nrl.3
move p1,t1
fsbr p1,u.absx(t4)
fmpr p1,p1
movem p1,f.data
move p1,t2
fsbr p1,u.absy(t4)
fmpr p1,p1
fadrm p1,f.data
move p1,t3
fsbr p1,u.absz(t4)
fmpr p1,p1
fadrm p1,f.data
movei c,f.loc
save t1
call sqrt.##
rest t1
fixr rs,rs
movem rs,n.rang(t4)
andi p2,17
caig rs,^d1024
call ncatal
caie p2,2
jrst nrl.2
move p2,u.tab(t4)
trne p2,@alya.u
aos n.pcnt
trnn p2,@mska.u
jrst nrl.3
andi p2,3b31
lsh p2,-4
nrl.2: caml rs,n.nran(p2)
jrst nrl.3
movem rs,n.nran(p2)
movem t4,n.nuot(p2)
nrl.3: sojge t4,nrl.1
move c,uot
trne c,1
call nrswap
rest p1,p2,p3
ret
;***** NCATAL
;
; the short range scan catalog routine.
NCATAL::
caig t4,7
jrst [move c,alya.t
tdnn c,u.tab(t4)
ret
aos n.scnt
move c,u.absx(t4)
movem c,u.lstx(t4)
move c,u.absy(t4)
movem c,u.lsty(t4)
move c,u.absz(t4)
movem c,u.lstz(t4)
jrst ncat.1]
caie p2,7
cain p2,1
ret
skipg time.q(t4)
call nqins
ncat.1: move c,mska.u
iorm c,u.tab(t4)
ret
;***** NQINS
NQINS::
move c,ally.n
tdne c,u.tab(t4)
ret
getime c
movem c,time.q(t4)
skipe q.time
camge c,q.time
movem c,q.time
ret
;***** NRSWAP
;
; swaps uots and ranges of near bases and ships.
NRSWAP::
dmove t1,nrpl.u
exch t1,t2
dmovem t1,nrpl.u
dmove t1,nrsb.u
exch t1,t2
dmovem t1,nrsb.u
dmove t1,nrsh.u
exch t1,t2
dmovem t1,nrsh.u
dmove t1,nupl.u
exch t1,t2
dmovem t1,nupl.u
dmove t1,nusb.u
exch t1,t2
dmovem t1,nusb.u
dmove t1,nush.u
exch t1,t2
dmovem t1,nush.u
ret
;***** AU.SEA, MISSION 0
;
; the basic mission, performed when no other mission applies.
; a tour at warp 7 of all bases and friendly planets. refuels
; at each stop.
AU.SEA::
setzm n.mssn(uot)
skipg t1,n.muot(uot)
jrst au.se1
skipl c,u.tab(t1)
trnn c,@alya.u
jrst au.se1
jrst au.se2
au.se1: call aubase
jrst au.se3
movem t1,n.muot(uot)
au.se2: move c,n.rang(t1)
caile c,^d512
pjrst a.mov7
move c,n.ener
camge c,[^d5000K]
pjrst a.reen
call aunxtb
jrst au.se3
movem t1,n.muot(uot)
pjrst a.mov7
au.se3: movei t1,^d1000
pjrst tqins
;***** Ax.REF, MISSION 1
;
; retreat to a base and refuel
AI.REF::
move c,n.ener
camge c,[^d2500K]
call aubase
retskp
movem t1,n.muot(uot)
movei c,1 ;REF mission code.
movem c,n.mssn(uot)
pjrst au.ref
AC.REF::
move c,n.ener
caml c,[^d5000K]
pjrst askipr
move t1,n.muot(uot)
skipl c,u.tab(t1)
trnn c,@alya.u
jrst [call aubase
pjrst askipr
movem t1,n.muot(uot)
jrst .+1]
pjrst au.ref
AU.REF::
hlrz c,n.mssn(uot)
jumpg c,au.re2
au.re1: move c,n.rang(t1)
caige c,^d512
jrst au.re9
jrst au.re8
au.re2: movei c,^d1024
camge c,nrpl.t
caml c,nrpl.n
jrst au.re5
caml c,nrsb.t
jrst au.re5
skipg t2,n.scnt
jrst au.re9
caile t1,sb.mx
jrst au.re6
caile t2,1
jrst au.re4
move c,n.ener
camge c,[^d2000K]
jrst au.re9
movei c,0
hrlm c,n.mssn(uot)
move t1,nush.t
movei t2,^d400
pjrst a.phas
au.re4: call aunxsb
jrst au.re7
au.re5: caig t1,sb.mx
jrst au.re8
au.re6: skipl t1,nusb.u
jrst au.re7
move t1,n.muot(uot)
call aunxtb
skipa t1,n.muot(uot)
au.re7: movem t1,n.muot(uot)
au.re8: movei c,0
hrlm c,n.mssn(uot)
caile t1,sb.mx
skipe n.scnt
pjrst a.mov8
pjrst a.mov7
au.re9: movei c,1
hrlm c,n.mssn(uot)
pjrst a.reen
;***** Ax.ESH, MISSION 2
AI.ESH::
move c,nrsh.t
caile c,^d1024
retskp
move t1,nush.t
movem t1,n.muot(uot)
movei c,2 ;ESH mission code.
movem c,n.mssn(uot)
pjrst au.es2
AC.ESH::
move t1,n.muot(uot)
move c,nrsh.t
caig c,^d1024
jrst ac.es1
move c,n.rang(t1)
caile c,^d1536
pjrst askipr
hlrz c,n.mssn(uot)
jumpe c,au.es3
skipg u.torp(uot)
pjrst au.es3
pjrst au.es1
ac.es1: cain t1,nush.t
jrst ac.es2
move t1,nush.t
movem t1,n.muot(uot)
pjrst au.es2
ac.es2: hlrz c,n.mssn(uot)
jumpn c,au.es2
move c,n.rang(t1)
caig c,^d256
pjrst au.es2
pjrst au.es3
AU.ES1::
movei c,0
hrlm c,n.mssn(uot)
pjrst a.phot
AU.ES2::
movei c,0
hrlm c,n.mssn(uot)
movei t2,^d400
pjrst a.phas
AU.ES3::
movei c,1
hrlm c,n.mssn(uot)
pjrst a.mov7
;***** Ax.EBA, MISSION 3
AI.EBA::
move c,n.pcnt
caile c,8
skipg t1,nusb.t
retskp
movem t1,n.muot(uot)
movei c,3 ;EBA mission code.
movem c,n.mssn(uot)
pjrst au.eba
AC.EBA::
move t1,n.muot(uot)
move c,n.pcnt
caile c,8
skipge u.tab(t1)
pjrst askipr
movei c,^d1024
camle c,nrsh.t
pjrst askipr
camg c,nrpl.t
camle c,nrpl.n
pjrst askipr
pjrst au.eba
AU.EBA::
move c,n.rang(t1)
cail c,^d2048
pjrst a.mov7
skiple u.torp(uot)
pjrst a.phot
cail c,^d1024
pjrst a.mov7
movei t2,^d400
pjrst a.phas
;***** Ax.CAP, MISSION 4
;
; capture a planet.
AI.CAP::
move t1,nupl.t
move t2,nrpl.t
camg t2,nrpl.n
jrst ai.ca1
move t1,nupl.n
move t2,nrpl.n
ai.ca1: skipge t1
retskp
movei c,4 ;CAP mission code.
movem c,n.mssn(uot)
movem t1,n.muot(uot)
pjrst au.cap
AC.CAP::
move c,nrsh.t
caig c,^d1024
pjrst askipr
hrrz t1,n.muot(uot)
move t2,n.rang(t1)
pjrst au.cap
AU.CAP::
move c,u.tab(t1)
trne c,@alya.u
pjrst askipr
cail t2,^d512
pjrst a.mov7
tlnn c,100
jrst au.ca3
au.ca1: aoj t1,
trnn t1,3
jrst au.ca2
skipge u.tab(t1)
jrst au.ca1
movei t2,^d500
pjrst a.phas
au.ca2: subi t1,4
save uot
move uot,t1
setz t1,
call tqins
rest uot
movei t1,^d750
pjrst tqins
au.ca3: setzm n.mssn(uot)
setom n.muot(uot)
move c,u.tab(t1)
trz c,7b31
ior c,alya.u
movem c,u.tab(t1)
movem t1,^d1000
pjrst tqins
;***** Ax.HLP, MISSION 5
AI.HLP::
move t3,u.alrt(uot)
and t3,mska.u
skipn t3
retskp
movei t1,7
movei t2,1b18
ai.hl1: came t1,uot
tdnn t3,t2
jrst ai.hl2
skipl u.tab(t1)
jrst ai.hl3
ai.hl2: lsh t2,-1
sojge t1,ai.hl1
retskp
ai.hl3: movem t1,n.muot(uot)
hrlm t2,n.muot(uot)
movei c,5 ;HLP mission code
movem c,n.mssn(uot)
pjrst au.hlp
AC.HLP::
hrrz t1,n.muot(uot)
came t1,uot
skipge u.tab(t1)
jrst ac.hl1
hlrz t2,n.muot(uot)
tdnn t2,u.alrt(uot)
jrst ac.hl1
pjrst au.hlp
ac.hl1: andcam t2,u.alrt(uot)
pjrst askipr
AU.HLP::
move c,n.rang(t1)
caile c,^d256
pjrst a.mov7
skiple c,u.shld(t1)
jrst au.hl9
movm c,c
add c,u.ener(t1)
camle c,[^d200K]
jrst au.hl9
move c,mask.a
hrli c,4
movsm c,eadd.a
movem uot,eadd.b
setzm eadd.t
save t1,t2
call lqins
rest t1,t2
move c,u.ener(t1)
add c,[^d400K]
movem c,u.ener(t1)
move c,u.ener(uot)
sub c,[^d400K]
movem c,u.ener(uot)
move c,t2
ior c,uot
hrli c,10
movsm c,eadd.a
movem t1,eadd.b
move c,n.rang(t1)
movem c,eadd.t
save t2
call lqins
rest t2
andcam t2,u.alrt(uot)
setzm n.mssn(uot)
setom n.muot(uot)
movei t1,^d3000
pjrst tqins
au.hl9: andcam t2,u.alrt(uot)
pjrst askipr
;***** SALLOC
;
; allocates a percent of UOT's total energy to the shields. T1
; contains the integer percent, eg 50 for 50 percent.
SALLOC::
save t2,t3
move c,n.ener
move t2,c
imul t2,t1
idivi t2,^d100
sub c,t2
movem c,u.ener(uot)
caig t2,^d100000
movn t2,t2
movem t2,u.shld(uot)
rest t2,t3
ret
;***** AUNXSB
AUNXSB::
save t2,t3,t4
move t2,uot
andi t2,1
addi t2,sb.mn
setz t3,
seto t4,
tlz t4,1b18
ans.1: came t2,t1
skipge u.tab(t2)
jrst ans.2
camg t4,n.rang(t2)
jrst ans.2
move t3,t2
move t4,n.rang(t2)
ans.2: addi t2,2
caig t2,sb.mx
jrst ans.1
skipe t3
move t1,t3
rest t2,t3,t4
ret
;***** AUBASE
;
; returns uot of nearest base in T1, range in T2. if no base exists,
; T1 < 0 and non-skip, otherwise a skip ret.
AUBASE::
move t1,nupl.u
move t2,nrpl.u
camg t2,nrsb.u
jrst .+3
move t1,nusb.u
move t2,nrsb.u
skipl t1
aos (p)
ret
;***** AUNXTB
AUNXTB::
movei t2,sb.mn
move t3,t1
call aunxb
jrst [sos t2,t1
movei t3,pl.mx
call aunxb
ret
jrst .+1]
move t1,t3
aos (p)
ret
aunxb: soj t3,
camge t3,t2
ret
skipl c,u.tab(t3)
trnn c,@alya.u
jrst aunxb
andi c,17
cail c,2
caile c,4
jrst aunxb
aos (p)
ret
;***** A.REEN
A.REEN::
move t2,t1
move t1,uot
call reener
movei t1,^d1500
pjrst tqins
;***** A.PHOT, A.PHAS
A.PHOT::
sos u.torp(uot)
movsi c,1b27
hrri c,^d200
movem c,a.fire
skipa
A.PHAS::
movem t2,a.fire
hrrz c,a.fire
imul c,c
exch c,u.ener(uot)
subm c,u.ener(uot)
call authit
movei t1,^d3000
pjrst tqins
;***** A.MOV7, A.MOV8, A.MOVE
A.MOV7::
movei t2,7
pjrst a.move
A.MOV8::
movei t2,8
pjrst a.move
A.MOVE::
call autxyz
move t1,n.rang(t1)
call autmot
skip
movei t1,^d1000
pjrst tqins
;***** AUTMOT
;
; moves UOT toward or away from coor A.ABSn at warp factor T2.
; T2 > 0 moves toward, T2 < 0 moves away. adjusts T2 down if
; insufficient energy for move, after 50/50 reallocation. skip
; return if move okay. non-skip return if ship needs energy.
; T1 must contain range from UOT to coordinates.
AUTMOT::
save t1,t2
movm t3,t2
move c,u.ener(uot)
am.1: caml c,wf.ene(t3)
jrst am.2
sojge t3,am.1
rest t1,t2
ret
am.2: rest t1,t2
move c,wf.ene(t3)
exch c,u.ener(uot)
subm c,u.ener(uot)
move c,wf.dis(t3)
skipge t2
movn c,c
move t2,c
call autmov
aos (p)
ret
;***** AUTXYZ
;
; moves abs coordinates of object T1 to A.ABSn.
AUTXYZ::
move c,u.absx(t1)
movem c,a.absx
move c,u.absy(t1)
movem c,a.absy
move c,u.absz(t1)
movem c,a.absz
ret
;***** AUTDIS (not referenced 1/8/81)
;
; computes T1 = range between UOT and coordinates A.ABSn.
AUTDIS::
move c,u.absx(uot)
fsbr c,a.absx
fmpr c,c
movem c,f.data
move c,u.absy(uot)
fsbr c,a.absy
fmpr c,c
fadrm c,f.data
move c,u.absz(uot)
fsbr c,a.absz
fmpr c,c
fadrm c,f.data
movei c,f.loc
call sqrt.##
fixr t1,rs
ret
;***** AUTMOV
;
; move object UOT toward (or away from) coordinates A.ABSX, A.ABSY,
; A.ABSZ at warp T2. T2 > 0 moves toward, T2 < 0 moves away. T1
; must contain range from UOT to coordinates.
AUTMOV::
skipg t1
ret
save p1,p2,p3
fltr t3,t2
fltr c,t1
fdvr t3,c
move t4,[1.0]
fsbr t4,t3
fmprm t3,a.absx
move p1,u.absx(uot)
fmpr p1,t4
fadr p1,a.absx
fmprm t3,a.absy
move p2,u.absy(uot)
fmpr p2,t4
fadr p2,a.absy
fmprm t3,a.absz
move p3,u.absz(uot)
fmpr p3,t4
fadr p3,a.absz
movem p1,u.absx(uot)
movem p2,u.absy(uot)
movem p3,u.absz(uot)
rest p1,p2,p3
hrlz c,mask.a
hrri c,1
movem c,eadd.a
movem uot,eadd.b
setzm eadd.t
pjrst lqins
;***** ASKIPR
ASKIPR::
setzm n.mssn(uot)
setom n.muot(uot)
RSKP:: aos (p)
R:: ret
;***** SETUP
SETUP::
setom u.side
call intlok
call gamchk
setz t1,
movei suot,sh.mx
set.a: move c,u.tab(suot)
tlne c,3b19
aoj t1,
sojge suot,set.a
cail t1,sh.ct
jrst [typec <[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>
jrst 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
pjrst select]
skipl c,u.tab(uot)
tlnn c,1b19
jrst gchk.1
move c,u.time(uot)
sub c,t2
skipg c
movn c,c
camle c,[^d300000]
jrst gchk.1
ife tops20,<getlin c,>
ifn tops20,<
save t2
gjinf
move c,t4
rest t2
>
movei uot,sh.mx+1
gchk.2: sojl uot,r
came c,u.tty(uot)
jrst gchk.2
move c,uot
andi c,1
movem c,u.side
gchk.3: skipl u.tab(c)
jrst gchk.4
addi c,2
caig c,sh.mx
jrst gchk.3
movei t1,[asciz /Federation/]
trne c,1
movei t1,[asciz /Klingon Empire/]
type <[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.
call timout
type < minute>
movei c,[asciz /s, /]
pop p,t1
cain t1,1
movei c,[asciz /, /]
outstr (c)
jrst .+1]
move t1,0(p)
call timout
type < second>
pop p,t1
caie t1,1
type <s>
crlf
setzm i.lock
ife tops20,<exit 1,> ;exit from the game.
ifn tops20,<haltf>
inchrw c
cain c,"Z"
ret
gexit
timout: idivi t1,^d10 ;displays a number without leading
save t2 ; zeroes.
skipe t1
call timout
rest t2
addi t2,"0"
outchr t2
ret
;***** INTLOK
;
; prevents two players from starting up at the same time. if i.lock < 0
; hibers for a second and tries again. when other player is finished
; i.lock will be = 0. this routine then sets i.lock < 0 to exclude
; other players and returns.
INTLOK::
ife tops20,<mstime t1,>
ifn tops20,<time>
skipn i.lock
jrst ilok.2
move c,t1 ;compares current time with i.time,
sub c,i.time ; which is the time the other player
skipge c ; grabbed i.lock. if the difference
movn c,c ; if > 5 mins, assume something is
camle c,[^d300000] ; wrong (crash during startup) and
jrst ilok.2 ; give player control immediately.
type <[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
skipl t4,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
outstr su.ln1
crlf
outstr su.ln2
ret
usrlod:
ife tops20,<
pjob t1,
movem t1,u.job(suot)
getlin t1,
movem t1,u.tty(suot)
move t1,[xwd -1,31]
gettab t1,
skip
movem t1,u.nam1(suot)
move t1,[xwd -1,32]
gettab t1,
skip
movem t1,u.nam2(suot)
move t1,[xwd -1,2]
gettab t1,
skip
movem t1,u.ppn(suot)
>
ifn tops20,<
gjinf
movem t3,u.job(suot)
movem t1,u.namx(suot)
movem t4,u.tty(suot)
>
ret
;***** ROTRAN
ROTRAN::
movei c,^d360
movem c,ran.mx
setzm ran.mn
call random
fltr t1,t1
movem t1,b1
call random
fltr t1,t1
movem t1,e1
call rot.zy
ret
;***** SELECT
;
; first player in the game selects startup options. this routine
; initializes the game.
SELECT::
type <[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
sel.tr: movem p2,gam.nr ;tournament game:
andi p2,17 ; cycle the randomizer 3 * tournament
imuli p2,3 ; number times.
call random
sojg p2,.-1
jrst sel.ld
sel.rn: setzm gam.nr ;random game:
call ranset ; seed the randomizer with mstime.
sel.ld: call loadq ;init the queue.
pjrst loadu ;init the universal object table.
;***** LOADQ
;
; Initializes the event queue.
LOADQ::
move c,[xwd 1777,777777]
movem c,mask.q
setzm q
move c,[xwd q,q+1]
blt c,q+q.size-1
setzm time.q
move c,[xwd time.q,time.q+1]
blt c,time.q+117
ret
;***** LOADU
;
; Loads the universal object table. All objects are loaded,
; including inactive ships. Objects are spaced a minimum of
; 512 units from each other.
LOADU::
setz uot,
lu.nxt: call lu.uot
cain t1,7
jrst .+6
call lu.lim ;get range limits
call lu.xyz ;get universal x, y, and z
call lu.tst ;test 512 distances
jrst .-2 ;not 512 from all other objects
call lu.mov ;move universal x, y, and z to uot
caige uot,217 ;all objects loaded?
aoja uot,lu.nxt ;no, repeat for next object
ret ;table loaded
lu.uot: move t1,u.tab(uot)
andi t1,7
move c,ui.t0(t1)
movem c,u.tab(uot)
move c,ui.e0(t1)
movem c,u.ener(uot)
move c,ui.s0(t1)
movem c,u.shld(uot)
caile uot,7
ret
movei c,^d10
movem c,u.torp(uot)
movei c,^d10000
movem c,time.q(uot)
move c,uot
tro c,10
movem c,n.muot(uot)
setzm n.mssn(uot)
setzm u.absx(uot)
setzm u.absy(uot)
setzm u.absz(uot)
setzm u.alrt(uot)
setzm u.time(uot)
setzm u.job(uot)
setzm u.tty(uot)
ife tops20,<
setzm u.ppn(uot)
setzm u.nam1(uot)
setzm u.nam2(uot)
>
ifn tops20,<
setzm u.namx(uot)
>
ret
lu.lim: movei t2,1
cain t1,1 ;star?
jrst [movei t1,^d4000
jrst lu.lm1]
cain t1,2 ;planet?
jrst [movei t1,^d2000
jrst lu.lm1]
movei t2,^d1250 ;set narrow limits
movei t1,^d2250 ;assures a reasonable separation
lu.lm1: movem t2,ran.mn ;save as random number generator
movem t1,ran.mx ; min and max range
aos t2,xyz.i
cail t2,10
setzb t2,xyz.i
ret ;return to calling routine
lu.xyz: call random ;get random x (ran.nr is also in t1)
movem t1,x1 ;save as x
call random ;get random y
movem t1,y1 ;save as y
call random ;get random z
movem t1,z1 ;save as z
call lu.str
jrst lu.xyz
move t2,xyz.i
move t2,xyz.t(t2)
move t1,x1
trnn t2,4 ;test if x is to be negative
movn t1,t1 ;(3 tests will select 1 of 8 sectors)
fltr t1,t1 ;convert to floating point
movem t1,x1 ;save as x
move t1,y1
trnn t2,2 ;test if y is to be negative
movn t1,t1 ;(the 2nd test)
fltr t1,t1 ;convert to floating point
movem t1,y1 ;save as y
move t1,z1
trnn t2,1 ;test if z is to be negative
movn t1,t1 ;(the 3rd test)
fltr t1,t1 ;convert to floating point
movem t1,z1 ;save as z
ret ;return to calling routine
lu.str: aos (p)
move t1,u.tab(uot)
andi t1,7
caie t1,1
ret
movei t1,^d2000
camg t1,x1
ret
camg t1,y1
ret
camle t1,z1
sos (p)
ret
lu.tst: jumpg uot,.+3 ;don't test if 1st element
aos (p) ;form skip ret
ret ;return to calling routine
movn t3,uot
hrlz t3,t3
lu.ts1: move t1,u.tab(t3)
andi t1,7
cain t1,7
jrst lu.ts2
move t1,x1 ;distance formula:
fsbr t1,u.absx(t3) ; d ** 2 =
fmpr t1,t1 ; (x - ux) ** 2) +
movem t1,t2 ; (y - uy) ** 2) +
move t1,y1 ; (z - uz) ** 2)
fsbr t1,u.absy(t3)
fmpr t1,t1
fadrm t1,t2
move t1,z1
fsbr t1,u.absz(t3)
fmpr t1,t1
fadrm t1,t2
camg t2,[262144.0] ;must be greater that 512 ** 2
ret ;failed test
lu.ts2: aobjn t3,lu.ts1 ;try the next entry
aos (p) ;passed test for all entries
ret
lu.mov: move t2,u.tab(uot)
andi t2,7
move t1,x1 ;get x
movem t1,u.absx(uot) ;store x
; caig uot,7
; movem t1,u.begx(uot)
cain t2,2
movem t1,1+u.absx(uot)
move t1,y1 ;get y
movem t1,u.absy(uot) ;store y
; caig uot,7
; movem t1,u.begy(uot)
cain t2,2
movem t1,2+u.absy(uot)
move t1,z1 ;get z
movem t1,u.absz(uot) ;store z
; caig uot,7
; movem t1,u.begz(uot)
cain t2,2
movem t1,3+u.absz(uot)
ret ;return to calling routine
;***** RANSET
;
; Seeds the Fortran random number generator with the current
; time of day.
RANSET::
ife tops20,<mstime t1,>
ifn tops20,<time>
movem t1,ran.sd
push sp,rs
push sp,ap
movei ap,[0,,ran.sd]
call setran##
pop sp,ap
pop sp,rs
ret
;***** RANDOM
;
; Gets a random number ran.nr between ran.mn and ran.max from the
; Fortran random number generator.
RANDOM::
move t1,ran.mx ;the formula is
sub t1,ran.mn ; nbr = min + ran * (max - min + 1)
aoj t1, ; where 0 < ran < 1
fltr t1,t1
save t1 ;RAN uses t1
setz rs,
call ran## ;number is reted in AC0
rest t1
fmpr t1,rs
fix t1,t1
add t1,ran.mn
movem t1,ran.nr
ret
;***** INIPSI
;
; Initializes ctrl-c trapping.
INIPSI::
ife tops20,<
movei ap,ivb
piini. ap,
jrst [typec <PIINI error>
exit 1,
exit]
move ap,[exp ps.fac+ps.fon+ccarg]
pisys. ap,
jrst [typec <PISYS error (CCTRAP)>
exit 1,
exit]
>
ifn tops20,<
cis ;clear int system
movei t1,ictrap
hrrm t1,chntab+1
movei t1,.fhslf
move t2,[levtab,,chntab]
sir
eir ;enable ints
movx t2,1b1!1b2 ;chls 1 and 2
aic
move t1,[.ticcc,,1] ;put ctrl-c on chl 1
ati
erjmp .+1 ; in case user has disabled this
move t1,[.ticti,,2] ;put typein on chl 2
ati
>
ret
;***** ICTRAP
ICTRAP::
type <[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
; control-c's.
WRAPUP::
movsi c,2000
lsh c,@suot
andcam c,mask.q
movs c,mask.c
movs t1,mask.a
movei p1,q.size-6
wrup.1: skipg evnt.t(p1)
jrst wrup.2
andcam c,evnt.a(p1)
tdnn t1,evnt.a(p1)
setzm evnt.t(p1)
wrup.2: subi p1,6
jumpge p1,wrup.1
wrup.3: movei c,^d5000
movem c,time.q(suot)
ife tops20,<
clrbfi
type <(B[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
movem t1,o.elev(uot)
ret
;***** RBECMP
RBECMP::
move t1,x1
fsbr t1,u.absx(suot)
movem t1,x2
move t1,y1
fsbr t1,u.absy(suot)
movem t1,y2
move t1,z1
fsbr t1,u.absz(suot)
movem t1,z2
move t1,x2
fmpr t1,s.11
movem t1,x1
move t1,y2
fmpr t1,s.12
fadrm t1,x1
move t1,z2
fmpr t1,s.13
fadrm t1,x1
move t1,x2
fmpr t1,s.21
movem t1,y1
move t1,y2
fmpr t1,s.22
fadrm t1,y1
move t1,z2
fmpr t1,s.23
fadrm t1,y1
move t1,x2
fmpr t1,s.31
movem t1,z1
move t1,y2
fmpr t1,s.32
fadrm t1,z1
move t1,z2
fmpr t1,s.33
fadrm t1,z1
move t1,x1
fmpr t1,t1
movem t1,x2
movem t1,f.data
move t1,y1
fmpr t1,t1
movem t1,y2
fadrm t1,f.data
move t1,z1
fmpr t1,t1
movem t1,z2
fadrm t1,f.data
movei c,f.loc
call sqrt.##
movem rs,r1
move t1,y1
fdvr t1,x1
movem t1,b1
move t1,x2
fadr t1,y2
movem t1,f.data
movei c,f.loc
call sqrt.##
move t1,z1
fdvr t1,rs
movem t1,e1
ret
;***** ROT.ZY
ROT.ZY::
move t1,b1
call sincos
call rot.z
move t1,e1
call sincos
call rot.y
ret
;***** ROT.X
ROT.X::
call savmat
move t1,a.21 ;s.21 = (a.31 * sin.a) + (a.21 * cos.a)
fmpr t1,cos.a
movem t1,s.21
move t1,a.31
fmpr t1,sin.a
fadrm t1,s.21
move t1,a.21 ;s.31 = (a.31 * cos.a) - (a.21 * sin.a)
fmpr t1,sin.a
movem t1,s.31
move t1,a.31
fmpr t1,cos.a
fsbrm t1,s.31
move t1,a.22 ;s.22 = (a.32 * sin.a) + (a.22 * cos.a)
fmpr t1,cos.a
movem t1,s.22
move t1,a.32
fmpr t1,sin.a
fadrm t1,s.22
move t1,a.22 ;s.32 = (a.32 * cos.a) - (a.22 * sin.a)
fmpr t1,sin.a
movem t1,s.32
move t1,a.32
fmpr t1,cos.a
fsbrm t1,s.32
move t1,a.23 ;s.23 = (a.33 * sin.a) + (a.23 * cos.a)
fmpr t1,cos.a
movem t1,s.23
move t1,a.33
fmpr t1,sin.a
fadrm t1,s.23
move t1,a.23 ;s.33 = (a.33 * cos.a) - (a.23 * sin.a)
fmpr t1,sin.a
movem t1,s.33
move t1,a.33
fmpr t1,cos.a
fsbrm t1,s.33
ret
;***** ROT.Y
ROT.Y::
call savmat
move t1,a.11 ;s.11 = (a.31 * sin.a) + (a.11 * cos.a)
fmpr t1,cos.a
movem t1,s.11
move t1,a.31
fmpr t1,sin.a
fadrm t1,s.11
move t1,a.11 ;s.31 = (a.31 * cos.a) - (a.11 * sin.a)
fmpr t1,sin.a
movem t1,s.31
move t1,a.31
fmpr t1,cos.a
fsbrm t1,s.31
move t1,a.12 ;s.12 = (a.32 * sin.a) + (a.12 * cos.a)
fmpr t1,cos.a
movem t1,s.12
move t1,a.32
fmpr t1,sin.a
fadrm t1,s.12
move t1,a.12 ;s.32 = (a.32 * cos.a) - (a.12 * sin.a)
fmpr t1,sin.a
movem t1,s.32
move t1,a.32
fmpr t1,cos.a
fsbrm t1,s.32
move t1,a.13 ;s.13 = (a.33 * sin.a) + (a.13 * cos.a)
fmpr t1,cos.a
movem t1,s.13
move t1,a.33
fmpr t1,sin.a
fadrm t1,s.13
move t1,a.13 ;s.33 = (a.33 * cos.a) - (a.13 * sin.a)
fmpr t1,sin.a
movem t1,s.33
move t1,a.33
fmpr t1,cos.a
fsbrm t1,s.33
ret
;***** ROT.Z
ROT.Z::
call savmat
move t1,a.11 ;s.11 = (a.21 * sin.a) + (a.11 * cos.a)
fmpr t1,cos.a
movem t1,s.11
move t1,a.21
fmpr t1,sin.a
fadrm t1,s.11
move t1,a.11 ;s.21 = (a.21 * cos.a) - (a.11 * sin.a)
fmpr t1,sin.a
movem t1,s.21
move t1,a.21
fmpr t1,cos.a
fsbrm t1,s.21
move t1,a.12 ;s.12 = (a.22 * sin.a) + (a.12 * cos.a)
fmpr t1,cos.a
movem t1,s.12
move t1,a.22
fmpr t1,sin.a
fadrm t1,s.12
move t1,a.12 ;s.22 = (a.22 * cos.a) - (a.12 * sin.a)
fmpr t1,sin.a
movem t1,s.22
move t1,a.22
fmpr t1,cos.a
fsbrm t1,s.22
move t1,a.13 ;s.13 = (a.23 * sin.a) + (a.13 * cos.a)
fmpr t1,cos.a
movem t1,s.13
move t1,a.23
fmpr t1,sin.a
fadrm t1,s.13
move t1,a.13 ;s.23 = (a.23 * cos.a) - (a.13 * sin.a)
fmpr t1,sin.a
movem t1,s.23
move t1,a.23
fmpr t1,cos.a
fsbrm t1,s.23
ret
savmat: move t1,[s.11,,a.11]
blt t1,a.11+^d8
ret
;***** SINCOS
SINCOS::
save t1,t2
movei ap,f.loc
movem t1,f.data
call sind.##
movem rs,sin.a
call cosd.##
movem rs,cos.a
rest t1,t2
ret
;***** CONUOT
CONUOT::
move t1,o.bear(uot)
movem t1,b1
move t1,o.elev(uot)
movem t1,e1
move t1,o.rang(uot)
movem t1,r1
move t1,o.relx(uot)
movem t1,x1
move t1,o.rely(uot)
movem t1,y1
move t1,o.relz(uot)
movem t1,z1
call conang
ret
;***** CONANG
CONANG::
move ap,e1
call atana
movem rs,e1
move ap,b1
call atana
skipl x1
jrst .+5
move ap,[-180.0]
skipg rs
movm ap,ap
fadr rs,ap
movem rs,b1
ret
;***** CONTRC
CONTRC::
move row,t.elev
fmpr row,[-0.25]
fadr row,[7.0]
fixr row,row
move col,t.bear
fmpr col,[0.625]
fadr col,[41.0]
fixr col,col
ret
;***** CONURC
CONURC::
move row,e1
fmpr row,[-0.25]
fadr row,[7.0]
fixr row,row
move col,b1
fmpr col,[0.625]
fadr col,[41.0]
fixr col,col
ret
;***** ATANA
ATANA::
call fatan
fmpr rs,[57.29577951]
ret
;***** FATAN
FATAN::
save t1,t2,t3
movem c,f.data
movei c,f.loc
call atan.##
rest t1,t2,t3
ret
;***** VTCMD
;
; Gets a command sequence from the terminal, returns the following:
;
; c.cmd - nbr of the command (0 = no cmd)
; c.dir - direction
; 0 = no direction
; 1 = up (FED or FWD)
; 2 = down (KLI or BAK)
; 3 = right (ALL)
; 4 = left (PLA)
; 5 = help
; c.nbr1 - 1st number
; c.nbr2 - 2nd number
; c.cnt - number of numbers entered
; c.imm - immediate execute flag
; 0 = no immediate command
; 1 = SR SCAN (FED)
; 2 = SR SCAN (KLI)
; 3 = SR SCAN (ALL)
; 4 = SR SCAN (PLA)
; 5 = LR SCAN
; 6 = RAPID FIRE PAHSER
; 7 = RAPID FIRE PHOTON
; -1 = more
VTCMD::
type <8>
setzm c.imm ;reset the immediate flag
skiple ap,c.dir
caie ap,5
skipa
jrst [setzm c.dir
type <[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
jrst vc.1b ;jump to keypad routine
vc.1a: caie t2,"-" ;was it the keypad dash?
jrst vc.1er ;no - error
movei t2,^d11 ;yes - substitute 11
vc.1b: movem t2,c.cmd ;store the command nbr
call vc.kbd ;display the abbr from the cmd table
jrst vc.2nd ;go get the 2nd field
vc.1c: caie t1,0 ;is the vcget integer equal to zero?
jrst vc.1er ;no - error
call vc.ifa ;is the vcget character a letter?
jrst vc.1er ;no - error
type <[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?
jrst vc.1d ;not a letter - validate 1-char
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)
jrst vc.hlp ;request for help on given cmd
jrst vc.can ;cancel command
jrst vc.can ;backspace is equivalent to cancel here
vc.2a: move t3,c.cmd
cain t3,^d20
jrst vc.2s
movei t3,^d47 ;entry point when input char is pending
call vc.col ;setup columns for 2nd field
setz t4, ;zero the offset for arrow entries
call vc.arr ;test if arrow was entered
jrst vc.3rd ;yes - go on to 3rd field
call vc.num ;number or sign?
jrst vc.2b ;yes - get rest of 2nd field
type <> ;no - signal error
jrst vc.2nd ;get the 1st char of 2nd field
vc.2s: call vc.sen
jrst vc.exe
type <>
jrst vc.2nd
vc.2b: call vcget ;get the next char of 2nd field
jrst vc.2c ;execute - must compute nbr1 first
jrst vc.2er ;help not allowed here
jrst vc.can ;cancel the command
jrst vc.2bk ;backspace to beginning of 2nd field
call vc.num ;test for number or sign
jrst vc.2b ;was a number or sign - get next char
vc.2c: move t3,i.nbr ;get the work number
skipe i.sign ;is the sign negative?
movns t3,i.nbr ;yes - form the negative
movem t3,c.nbr1 ;store in 1st number
aos c.cnt ;increment the count
cain t1,^d13 ;was the last command an execute?
jrst vc.exe ;yes - skip field 3
movei t4,7 ;setup 3rd field offset if arrow
setzm i.path ;reset direction flag - assume 2 nbrs
call vc.arr ;no - was it an arrow?
jrst vc.4th ;an arrow - get the terminator
call vc.brk ;was the entry a break character?
jrst vc.3rd ;yes - start the 3rd field
vc.2er: type <> ;none of the above - therefore an error
jrst vc.2b ;get another character
vc.3bk: type <[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
call vc.num ;was the entry a number or a sign?
jrst vc.3b ;yes - get the rest of 3rd field
skipe i.path ;has an arrow been entered already?
jrst vc.3x ;yes - skip the arrow test
setz t4, ;zero the offset for arrow entries
call vc.arr ;was an arrow entered?
jrst vc.4th ;an arrow - get the terminator
vc.3x: type <> ;none of the above - signal an error
jrst vc.3rd ;restart at 3rd field
vc.3b: call vcget ;get the next char of the 3rd field
jrst vc.3c ;execute - must compute nbr first
jrst vc.3er ;help not allowed here
jrst vc.can ;cancel the command
jrst vc.3bk ;backspace to beginning of 3rd field
call vc.num ;number or sign entered?
jrst vc.3b ;yes - get more
vc.3c: move t3,i.nbr ;get the work nbr
skipe i.sign ;is the sign negative?
movns t3,i.nbr ;yes - form a negative number
skipe i.path ;is this the 2nd number?
jrst .+3 ;no - store in nbr1
movem t3,c.nbr2 ;yes - store it
jrst .+2 ;skip the next
movem t3,c.nbr1 ;store in nbr1
aos c.cnt ;increment the count
cain t1,^d13 ;was the last character entered an execute?
jrst vc.exe ;yes - skip the terminator
vc.3er: type <> ;none of the above - an error
jrst vc.3b ;get the next character
vc.4er: type <> ;signal an error
vc.4th: call vcget ;get a terminator
jrst vc.exe ;the desired response
jrst vc.4er ;help not allowed at this point
jrst vc.can ;cancel the command
jrst .+2 ;backspace to field 3
jrst vc.4er ;must be a terminator
setzm c.dir ;reset the direction
setzm i.path ;reset the direction-entered flag
type <[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
vc.imm: aos (sp) ;form skip - assume not immediate
caie t1,"" ;escape sequence?
ret ;no - can't be immediate (arrow)
cain t2,"0" ;keypad zero? (LR SCAN)
jrst [movei t2,5 ;yes
jrst vc.imx]
cain t2,"." ;keypad period? (MORE)
jrst [seto t2, ;yes
jrst vc.imx]
cail t2,"A" ;is the character
caile t2,"D" ; one of the letters A, B, C, or D?
skipa ;no
jrst [andi t2,7 ;yes - mask out all but last three bits
jrst vc.imx]
skipn r.fire ;rapid fire enabled?
ret ;no - ret
caie t2,"5" ;rf phasers?
cain t2,"6" ;rf photon torpedo?
skipa ;yes
ret ;no
andi t2,7 ;mask the bits
aoj t2, ;incr to form immediate cmd
vc.imx: movem t2,c.imm ;store as the immediate flag
sos (sp) ;cancel the skip
ret ;return to calling routine
vc.kbd: type <[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
vc.col: movem t3,i.spos ;store sign position
aoj t3, ;add 1
movem t3,i.pos ;store as first nbr position
addi t3,3 ;compute the last allowable position
movem t3,i.max ; and store it
setzm i.nbr ;reset the work nbr
setzm i.sign ;reset the sign flag
ret ;return to calling routine
vc.arr: aos (sp) ;form skip - assume not an arrow
caie t1,"" ;escape sequence?
ret ;no - can't be an arrow
move t3,i.spos ;get the cursor position
add t3,t4 ;add the offset, if any
cail t2,"A" ;is the character
caile t2,"D" ; one of the letters A, B, C, or D?
ret ;no - return to calling routine
sos (sp) ;yes - cancel the skip - it's an arrow
call vpos ;position the cursor
andi t2,7 ;convert char to a directional nbr
movem t2,c.dir ;store the direction
move t3,c.cmd ;get the command nr
hlrz t3,c.tab(t3) ;get the d.tab offset
add t3,t2 ;add the direction
type <[7m>
outstr d.tab(t3) ;display the direction literal
type < 8> ;display final spaces and restore cursor
setom i.path ;set flag indicating arrow was entered
ret ;return to calling routine
vc.sen: aos (sp)
caie t1,""
jrst vc.sn1
movsi t3,-4
came t2,[exp "A","B","C","D"](t3)
aobjn t3,.-1
skipl t3
ret
move t3,[exp 1, 2, 0, 0](t3)
jrst vc.sn2
vc.sn1: trz t2,1b30
movsi t3,-^d11
came t2,[exp "A","F","K","E","C","I","H","L","P","V","R"](t3)
aobjn t3,.-1
skipl t3
ret
vc.sn2: type <[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
vc.num: aos (sp) ;form skip return - assume not a number
call vc.ifn ;test numeric
jrst vc.sig ;not a number, try a sign
sos (sp) ;cancel the skip ret
move t3,i.pos ;get the column nbr
camg t3,i.max ;greater than max allowed?
jrst .+3 ;no - continue
type <> ;yes - signal the error
ret ;return to calling routine
call vpos ;position the cursor
type <[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
movei t3," " ;wasn't negative after all, use space
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
aos (sp) ;form skip return 1
cain t2,"?" ;help function?
ret ;yes - skip return 1
aos (sp) ;form skip return 2
cain t2,^d127 ;delete?
ret ;yes - skip return 2
aos (sp) ;form skip return 3
cain t1,^d8 ;backspace?
ret ;yes - skip return 3
cain t2,"," ;erase function? (same as backspace)
ret ;yes - skip return 3
aos (sp) ;form skip return 4
ret ;none of the above - skip return 4
;***** SCANLD
SCANLD::
call scnclr
movei uot,217
skipge u.tab(uot)
jrst .+3
came uot,s.uot
call scntst
sojge uot,.-4
ret
;***** SCNTST
;
; tests whether an object is in scan range. if so, SCNUPD is
; called (updating scan tables) and row.2 is set = to the row
; containing the object
SCNTST::
setzm row.2
skipg o.relx(uot) ;object in front of us?
ret ;no - can't be in viewer
movm t1,o.elev(uot) ;object has a reasonable elevation?
camle t1,[0.404026226]
ret ;no
movm t1,o.bear(uot) ;object has a reasonable bearing?
camle t1,[1.625476800]
ret ;no
fix t1,o.rang(uot)
caig uot,117 ;if the object isn't a star,
caig t1,^d2048 ; is it out of range?
skipa ;no - it's in range
ret ;yes - it's out of range
move ap,o.elev(uot) ;compute the exact row
call fatan
fmpr rs,[14.32394488]
move row,[7.0]
fsbr row,rs
fixr row,row
skiple row
caile row,^d13
ret ;row not in viewer
move ap,o.bear(uot) ;compute the exact col
call fatan
fmpr rs,[35.80986218]
fadr rs,[41.0]
fixr col,rs
cail col,6
caile col,^d76
ret ;col not in view
movem row,row.2
call scnupd
ret
;***** SCNCLR
;
; Zeroes out the scanner table and moves zero to s.max, the
; number of elements in the table.
SCNCLR::
move t1,[scan.1,,scan.1+1]
setzm scan.1
blt t1,scan.1+^d289
setzm s.max
ret
;***** SCNUPD
;
; Updates the scanner table. Table is in ascending sequence
; by row and descending sequence by range within row. This
; allows VIEWLD to process a row at a time. Descending ranges
; allow VIEWLD to overlay the character elements in the viewer
; table; assures that closer objects will overlay farther objects.
;
; Uses the following:
; w.row - row on which object will be displayed
; w.col - col on which the center of the object will display
; w.rang - range as a floating point nbr
; w.id - object id
; w.uot - object nr (universal object idx)
SCNUPD::
setz t1, ;t1 is the scan table index
fix t2,o.rang(uot) ;get the range
aos s.max ;incr the element count
sc.tst: hrrz t3,scan.1(t1) ;main loop - get a scanner element
trz t3,-1000 ;mask everything but the row
caml t3,row ;scan row less than new object row?
jrst .+3 ;no - test same row
jumpe t3,sc.upd ;end of table? - if so, add to end
aoja t1,sc.tst ;try the next element
came t3,row ;is there another object on this row?
jrst sc.shf ;no - push the table and insert
camg t2,scan.2(t1) ;range greater than new range?
aoja t1,sc.tst ;no - try the next element
sc.shf: move t4,s.max ;get the (new) table size
move t3,scan.1-1(t4) ;shift the elements down one
movem t3,scan.1(t4) ;
move t3,scan.2-1(t4) ;shift the ranges also
movem t3,scan.2(t4) ;
soj t4, ;decr the table idx
camle t4,t1 ;are we at the insertion point?
jrst .-6 ;no - shift the next element
sc.upd: hrrz t3,uot ;update - get the uot idx (obj nr)
hrrz t4,col ;get the column
lshc t3,^d9 ;shift t3 and t4 a quarter word left
move ap,u.tab(uot) ;get the u.tab word
andi ap,17 ;mask everything but the uid
ior t3,ap ;insert the object id
ior t4,row ;insert the row
hrl t4,t3 ;combine t3 with t4
movem t4,scan.1(t1) ;store in scan.1
movem t2,scan.2(t1) ;store the range in scan.2
ret ;return to calling routine
;***** SCNDEL
;
; searches for an object uot in the scan tables and, if found,
; deletes it. if an object was found, its row is stored in
; row.1. if not found, row.1 will = 0.
SCNDEL::
setzb t1,row.1
scd.1: skipn scan.1(t1) ;search for the uot
ret ;not found
hlrz t2,scan.1(t1)
lsh t2,-^d9
came t2,uot
aoja t1,scd.1
hrrz t2,scan.1(t1)
trz t2,-1000
movem t2,row.1
sos s.max
scd.2: move t2,scan.2+1(t1) ;close up the hole in the scan
movem t2,scan.2(t1) ; table
move t2,scan.1+1(t1)
movem t2,scan.1(t1)
skipe t2
aoja t1,scd.2
ret
;***** VIEWLD
;
; loads the viewer table from the scan table
VIEWLD::
push sp,p1
push sp,p2
setzm v.mod
setzm v.row
setzb p1,row
hrrz p2,scan.1(p1)
trz p2,-1000
vwl.1: aoj row,
call vwrupd
caige row,^d13
jrst vwl.1
pop sp,p2
pop sp,p1
ret
;***** VWRTST
;
; updates two viewer rows. intended specifically for the case
; when an object moves. row.1 is the 'old' row, most probably
; set up by SCNDEL. row.2 is the 'new' row, set up by SCNTST.
; a row isn't processed if it equals zero. also, if the new
; row = the old row, it's not necessary to process the new row.
VWRTST::
setzm v.rset ;will be set to -1 if a char is displayed.
skipn row,row.1
jrst vwt.1
camn row,t.row
call tarupd
move row,row.1
call vwrchg
vwt.1: skipe row,row.2
camn row,row.1
jrst vwt.2
camn row,t.row
call tarupd
move row,row.2
call vwrchg
vwt.2: skipe v.rset ;any characters displayed?
type <8> ;yes, reset the cursor position.
ret
;***** VWRCHG
;
; changes a single viewer row after finding it in the scan
; table. different from VIEWLD, which loads all rows
VWRCHG::
push sp,p1
push sp,p2
setzm v.mod
setzb p1,v.row
vwc.1: skipn p2,scan.1(p1)
jrst vwc.2
hrrz p2,p2
trz p2,-1000
camge p2,row
aoja p1,vwc.1
vwc.2: call vwrupd
pop sp,p2
pop sp,p1
ret
VWRUPD::
came row,t.row
jrst vwu.1
call vwrini
camn row,p2
call vwrrow
call vwrtar
jrst vwu.2
vwu.1: came row,p2
jrst vwu.3
call vwrini
call vwrrow
vwu.2: skipl v.flag
jrst .+3
call vwrins
skipa
call vwrdsp
jrst vwu.4
vwu.3: skipge v.flag
jrst .+3
call vwrnul
skipa
call vwrdel
vwu.4: setzm v.flag
ret
;***** VWRDEL
VWRDEL::
call vr.tst
ret
call vr.ini
setz t3,
aoj col,
idpb t3,v.tptr
caige col,^d74
jrst .-3
ret
VWRINI::
move t1,[v.wrk,,v.wrk+1]
setzm v.wrk
blt t1,v.wrk+^d13
ret
VWRROW::
move t1,scan.2(p1)
lsh t1,-5
cail t1,100
movei t1,77
trz t1,7
hlrz t2,scan.1(p1)
trz t2,-10
add t1,t2
hrrz t2,v.obj(t1)
trz t2,-10
cail t2,7
jrst vr.nxt
hrrz t3,scan.1(p1)
lsh t3,-^d9
sub t3,t2
soj t3,
adjbp t3,v.wrkp
movem t3,v.wptr
move t2,v.obj(t1)
lshc t1,5
andi t1,37
trnn t1,37
jrst vr.nxt
idpb t1,v.wptr
jrst .-5
vr.nxt: aoj p1,
hrrz p2,scan.1(p1)
trz p2,-1000
camn p2,row
jrst vwrrow
ret
VWRTAR::
move col,t.col
cain row,7
caie col,^d41
skipa
ret
cail col,2
caile col,^d74
ret
adjbp col,v.wrkp
ldb t1,col
tro t1,40
dpb t1,col
ret
VWRCLR::
move t1,[v.tab,,v.tab+1]
setzm v.tab
blt t1,v.tab+^d172
ret
VWRINS::
call vr.tst
ret
call vr.ini
adjbp t3,v.wrkp
movem t3,v.wptr
vi.nxt: aoj col,
ildb t2,v.wptr
trz t2,40
idpb t2,v.tptr
caige col,^d74
jrst vi.nxt
ret
VWRDSP::
call vr.tst
ret
call vr.ini
adjbp t3,v.wrkp
movem t3,v.wptr
vr.dsp: aos t1,col
ildb t2,v.wptr
ildb t3,v.tptr
came t2,t3
call vr.out
caige t1,^d74
jrst vr.dsp
ret
vr.out: setom v.rset ;a char will be displayed, must reset later.
call vnextp
dpb t2,v.tptr
setz t4,
trze t2,40
movei t4,40
;; dpb t2,v.tptr
hlrz t3,v.elem(t2)
jumpe t3,.+4
came t3,v.mod
outstr v.mod(t3)
movem t3,v.mod
hrrz t3,v.elem(t2)
caie t4,0
type <[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
setom t.view
ret
tu.brk: mspini
msptyp <target no longer locked>
mspout
setom t.uot
setzm t.bear
setzm t.elev
movei row,7
movei col,^d41
movem row,t.row
movem col,t.col
setom t.view
ret
;***** TARDSP
;
; Displays reverse-video blinking target at w.row and w.col.
TARDSP::
setz t1, ;t1 will flag a difference in position
camn row,t.row ;new row same as old?
came col,t.col ;new col same as old?
seto t1, ;no - t1 < 0 implies difference
move t2,t.view ;get viewer flag (0 = not in view)
jumpe t2,td.tst ;if wasn't in view, skip
jumpe t1,td.tst ;if in view but same location, skip
push sp,row ;save new row and col
push sp,col ;
move row,t.row ;get old row and col
move col,t.col ;
call td.get ;get the character number from viewer table
trz t2,40
dpb t2,t3
type <[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
caile row,^d12 ; row must be between 2 and 12
jrst td.sav
cail col,^d8 ;test col
caile col,^d74 ; col must be tween 8 and 74
jrst td.sav
setom t.view ;target in view, flip view flag
call td.get ;get the char nbr at this row and pos
cain row,7
caie col,^d41
jrst [tro t2,40
dpb t2,t3
trz t2,40
jrst .+1]
jumpn t1,.+3 ;different position for target?
camn t2,t.elem ;no - different element number?
jrst td.sav ;no - don't bother to display it again
type <[;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
td.dsp: cain row,^d7 ;if target is at center of viewer
caie col,^d41 ; (row = 7 and col = 41)
skipa ; don't display
ret
call vtpos ;position the cursor
hlrz t3,v.elem(t2) ;get the mode of the element
skipe t2 ;mode important?
outstr v.mod(t3) ;yes - change the mode
hrrz t3,v.elem(t2) ;get the character
trne t3,200 ;bold character?
type <[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
jrst vnxt.1
camg col,v.col
jrst vnxt.1
move t3,col
sub t3,v.col
soje t3,vnxt.1+1
type <[>
idivi t3,^d10
tro t3,"0"
tro t4,"0"
caie t3,"0"
outchr t3
outchr t4
type <C>
skipa
vnxt.1: call vtpos
movem row,v.row
movem col,v.col
ret
;***** VTPOS
;
; Positions cursor at row and col. Works for 2-digit row
; and col. Destroys t3 and t4.
VTPOS::
type <[> ;display start of sequence
move t3,row ;move the row
idivi t3,^d10 ;divide by 10 (remainder is in t4)
tro t3,"0" ;convert tens to ascii
tro t4,"0" ;convert units to ascii
caie t3,"0" ;skip tens if zero
outchr t3 ;display tens
outchr t4 ;display units
type <;> ;display sequence delimiter
move t3,col ;move the col
idivi t3,^d10 ;divide by 10 (remainder is in t4)
tro t3,"0" ;convert tens to ascii
tro t4,"0" ;convert units to ascii
caie t3,"0" ;skip tens if zero
outchr t3 ;display tens
outchr t4 ;display units
type <H> ;display final control sequence character
ret ;ret
;***** VTGET
;
;
; Gets a character from the terminal, returns c.inte and
; c.char as follows:
;
; Normal entries: 0 in c.inte, character entered in c.char.
; Control char: ADE nbr in c.inte, space in c.char
; (delete returns 127 in c.inte, space in c.char).
; Keypad keys: 27 (escape) in c.inte, the following in c.char:
; up A
; down B
; right C
; left D
; pf1-4 A,B,D,C (note sequence)
; 0-9 0-9
; comma comma
; dash dash
; period period
; enter M in c.char, 13 in c.inte (cr)
VTGET::
call vtimed ;get a character (timed interrupt)
type <8>
andi t4,177 ;mask the last 8 bits
setzm c.inte ;zero the integer
movei t1," " ;move space to the char
caige t4," " ;is it a ctrl char? (less than space)
jrst vt.ctl ;yes
caie t4,177 ;no - is it a delete?
jrst vt.chr ;no - it's just a normal character
movem t4,c.inte ;yes, a delete - move it to integer
jrst vt.sav ;go to ret
vt.ctl: movem t4,c.inte ;move to integer
cain t4,33 ;is it an escape?
jrst vt.esc ;yes - assume an escape sequence
ife tops20,<
cain t4,15 ;not an escape - is it a carriage ret?
inchrw t3 ;yes - ignore the linefeed
>
jrst vt.sav ;go to ret
vt.esc: inchrw t4 ;get the next esc sequence character
andi t4,177 ;mask the last 8 bits
cain t4,"[" ;is it a keypad sequence?
jrst vt.kpd ;yes - process it
caie t4,"O" ;an arrow?
jrst vt.chr ;no - don't know what it is
;yes - process the sequence
vt.kpd: inchrw t4 ;get the next character
andi t4,177 ;mask the last 8 bits
caige t4,"l" ;is it lowercase L or greater?
jrst vt.upr ;no - probably an uppercase letter
caile t4,"y" ;is it lowercase Y or less?
jrst vt.chr ;no - don't know what it is
andi t4,77 ;make it a number or - , . character
jrst vt.chr ;go to ret
vt.upr: caie t4,"M" ;was it the ENTER key?
jrst vt.pf ;no - test the pf keys
movei t3,15 ;generate a carriage ret
movem t3,c.inte ;move cr to integer
jrst vt.chr ;go to ret
vt.pf: cain t4,"P" ;is it pf1?
movei t4,"A" ;yes - convert to up arrow
cain t4,"Q" ;is it pf2?
movei t4,"B" ;yes - convert to down arrow
cain t4,"R" ;is it pf3?
movei t4,"D" ;yes - convert to left arrow
cain t4,"S" ;is it pf4? (if not, it's probably an arrow)
movei t4,"C" ;yes - convert to right arrow
vt.chr: movem t4,t1 ;move t4 to t1
vt.sav: movem t1,c.char ;save the character
ret ;return to calling routine
;***** VTIMED
VTIMED::
call d.time
ife tops20,<
seto t1,
wake t1,
skip
movsi t1,1b32
hrri t1,^d500
move t2,t1
hiber t2,
skip
hiber t1,
skip
inchrs t4
jrst [call qtest
jrst vtimed]
ret
>
ifn tops20,<
movei t1,.priin
sibe
jrst vtinp
movei t1,^d500
disms
vtdsms: movei t1,.priin
sibe ;input now?
jrst vtinp
call qtest ;no - do q-processing
jrst vtimed
vtinp: inchrw t4
ret
;***** ITYPIN - get typein interrupts
itypin: save t1
hrrz t1,lev2pc ;check interrupt PC
caie t1,vtdsms
jrst itypix ;not waiting - exit
movsi t1,10000 ;user mode flag
iorm t1,lev2pc ;debrk back to wakeup
itypix: rest t1
debrk
>
ife tops20,<
d.time:
mstime t1,
idiv t1,[^d60000]
idiv t1,[^d60]
came t1,l.hr
pjrst d.hour
came t2,l.mn
pjrst d.min
ret
d.hour: movem t1,l.hr
movem t2,l.mn
type <[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
call dspbr2
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>
movei 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
ife tops20,<
move t1,[xwd -1,2]
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
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
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.
/]
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>
exit
;***** 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
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)
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
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>