pfuetz@agd.fhg.de (02/26/91)
Submitted-by: pfuetz@agd.fhg.de
Posting-number: Volume 11, Issue 89
Archive-name: xstrek/part03
#!/bin/sh
# To unshare, sh or unshar this file
echo xstrek/f_changed/strek_main.f 1>&2
sed -e 's/^X//' > xstrek/f_changed/strek_main.f <<'E!O!F! xstrek/f_changed/strek_main.f'
X program strek_main
Xc
Xc *******************************************************************
Xc ***** *****
Xc ***** STAR TREK VERSION 3.0 *****
Xc ***** *****
Xc ***** written by *****
Xc ***** *****
Xc ***** Justin S. Revenaugh *****
Xc ***** *****
Xc ***** 7/87 *****
Xc ***** *****
Xc ***** Massachussetts Institute of Technology *****
Xc ***** Department of Earth, Atmospheric and Planetary Science *****
Xc ***** *****
Xc *******************************************************************
Xc
Xc STREK_MAIN is the main calling code for the STREK system.
Xc It handles the database startup calls, graphics init call,
Xc the screen update - resolve - key request sequence.
Xc When the ship docks or dies it updates the database.
Xc
Xc version 2.0
Xc
Xc % include '/sys/ins/base.ins.ftn'
Xc % include '/sys/ins/gpr.ins.ftn'
Xc % include '/sys/ins/smdu.ins.ftn'
Xc % include '/sys/ins/time.ins.ftn'
Xc % include '/sys/ins/cal.ins.ftn'
X logical gprcondeventwait
Xc
Xc STREK declarations
Xc
X parameter (pi = 3.141592653)
X integer*2 font_3, font_4, clock(3), timer(3), wait(3), center(2)
X integer*2 event_type, c_pos(2), key_set(16)
X integer*4 status, last_score, cum_score, photons, waited
X integer*4 photon_c(6), r_index, bitmap_desc, scan_ob, turns_wait
X integer*4 ph_object, tr_object, pos_store(0:9,2)
X integer*4 option, phase_c, score, index(0:9), item, type, l_object
X integer*4 txc, tyc, tzc, trange, rate, cm(3), cs(3), pc(3)
X integer*4 ship_k, ship_r, ship_n, dock_n
Xc
Xc real variables (all ship position data)
Xc
X real*4 trx, try, trz, trazm, trangle, trdist, tr_cost(0:9)
X real*4 rot_azm(10), rot_ang(10), rot_cost(10), rox(0:9)
X real*4 roy(0:9), roz(0:9), pro_x(0:9), pro_y(0:9), xt(0:9)
X real*4 yt(0:9), zt(0:9), xc, yc, zc, azm, value(9)
X real*4 angle, obx(0:9), oby(0:9), obz(0:9), oazm(0:9)
X real*4 oangle(0:9), ospeed(0:9), orange(0:9), speed, energy
X real*4 distance(3,0:9), odamage(0:9), d_pct(6), seed
X real*4 damage, maxd(9), photon_tr(4:9), razm(3), rangle(3)
X real*4 brake(3), ran_store(0:9), soa(9), coa(9), sop(9), cop(9)
X real*8 elapsed, turn, duration
Xc
Xc message strings
Xc
X character user_name*10
X character capt_name*10, nick_name*10, ship_name*30
X character*1 key, t_key, dam_rating(3)*10, means(90)
X character*80 message(3), t_message(3), s_message(17)
X character*80 b_message(3), p_message(3), u_message(6)
X character*80 sc_message(6), d_message(6), k_message(3)
X character*80 ph_message(6), a_message(3), ps_message(6)
X character*80 ap_message(3), l_message(6), r_message(3)
X character*80 e_message(3), sl_message(3)
X character*256 key_file
Xc
Xc logical toggles for objects
Xc
X logical input_event, new_ship, scan, tract, phase, found
X logical tract_ob, rotate, object(0:9), kling(3), phase_d
X logical plot(0:9), two, agr(3), lock_on, reverse, unobscured
X logical refresh
Xc
Xc key interpretation common
Xc
X common /key_defs/ means
Xc
Xc data for STREK
Xc
X data index /1, 2, 3, 4, 5, 5, 5, 6, 6, 6/
X data key_set /16 * 16#ffff/
X data ship_k, ship_r, ship_n, dock_n/4*0/
X data c/0/
X data waited, turns_wait / 0, 0/
X data cm, cs, pc /3*0, 3*0, 3*3/
X data rot_azm /0.0, -2.0, 2.0, 0.0, 0.0, -1.0, 1.0, 0.0, 2*0.0/
X data rot_ang /2.0, 0.0, 0.0, -2.0, 1.0, 0.0, 0.0, -1.0, 2*0.0/
X data rot_cost, rotate /8*.25, 0.0, 0.25, .true./
X data r_index, photon_tr /9, 6*900.0/
X data xc, yc, zc, azm, angle /0.0, -50.0, 0.0, 0.0, 0.0/
X data photons, speed, energy, damage /20, 0.0, 1000.0, 0.0/
X data d_pct, odamage /6*1.0, 10*0.0/
X data tr_cost /0.0, 0.4, 2.0, 2.0, 6*1.0/
X data obx(0), oby(0), obz(0)/3*0.0/
X data ospeed, oangle, oazm /10*0.0, 10*0.0, 10*0.0/
X data score, maxd, value /0, 5.0, 2*0.0, 6*12.5, -200.0, 2*300.0,
X & 6*0.0/
X data sa, ca, sp, cp /0.0, 1.0, 0.0, 1.0/
X data rox, roy, roz / 30 * 0.0/
X data scan, tract, phase, phase_d/3*.true., .false./
X data tract_ob, scan_ob, tr_object /.false., 1, 0/
X data object, plot /.true., 9*.false., 10*.false./
X data lock_on, refresh /.false., .true./
X data dam_rating /'light', 'moderate', 'heavy'/
X data t_message /'Which should I lock onto captain?',
X & 'Input number of object to lock,'
X & ,'any other input = No lock on '/
X data p_message /'Phaser control',
X & 'Input number of object to lock phasers on,'
X & ,'any other input = No phaser lock on '/
X data e_message /'Photon Torpedo Trigger Radius Options',
X & '1 = 15 2 = 20 3 = 25 4 = 30 5 = 35 6 = 40',
X & 'Enter option.'/
X data r_message /'Statistics for ',
X & 'Klingons Romulans Nemians Nemians Docked Sco
X &re Total', ' '/
X data a_message, b_message, k_message /9*' '/
X data ap_message(1) /'Ship hit by enemy photon!'/
X data ap_message(2) /' '/
X data d_message(1) /' '/
X data d_message(2) /'Nemian freighter destroyed.'/
X data d_message(3) /'Enemy spacecraft destroyed.'/
X data d_message(4) /'Second enemy spacecraft destroyed.'/
X data d_message(5) /'Enemy photon torpedo destroyed.'/
X data d_message(6) /'Photon torpedo destroyed.'/
X data l_message(1) /'Navigation lock on star base.'/
X data l_message(2) /'Navigation lock on Nemian freighter.'/
X data l_message(3) /'Navigation lock on enemy spacecraft.'/
X data l_message(4) /'Navigation lock on second enemy spacecraft.'/
X data ph_message(2) /'Nemian freighter hit by photon torpedo.'/
X data ph_message(3) /'Enemy ship hit by photon torpedo.'/
X data ph_message(4) /'Enemy ship hit by photon torpedo.'/
X data ps_message(2) /'Nemian freighter hit by phaser fire.'/
X data ps_message(3) /'Enemy ship hit by phaser fire.'/
X data ps_message(4) /'Enemy ship hit by phaser fire.'/
X data ps_message(5) /'Enemy Photon torpedo hit by phaser fire.'/
X data ps_message(6) /'Photon torpedo hit by phaser fire.'/
X data s_message(2) /'Tractor beam on Nemian freighter dropped.'/
X data s_message(5) /'Tractor beam on enemy photon dropped.'/
X data s_message(6) /'Tractor beam on photon torpedo dropped.'/
X data s_message(7) /'Tractor beam lock on dropped.'/
X data s_message(8) /'Photon torpedo launched sir.'/
X data s_message(9) /'I''m giving it all she''s got captain.'/
X data s_message(10) /'Scanner lock on lost.'/
X data s_message(11) /'Nemian freighter docked at star base.'/
X data s_message(12) /'Score for destroying ship: '/
X data s_message(13) /'Good going '/
X data s_message(14) /'Scanners report that the damage was '/
X data s_message(15) /'Repair parties report that the damage was '/
X data s_message(16) /'Points lost '/
X data s_message(17) /'It''s your job to defend the Nemians '/
X data sc_message(1) /'Scanner locked on starbase.'/
X data sc_message(2) /'Scanner locked on Nemian freighter.'/
X data sc_message(3) /'Scanner locked on enemy ship.'/
X data sc_message(4) /'Scanner locked on second enemy ship.'/
X data sc_message(5) /'Scanner locked on enemy photon.'/
X data sc_message(6) /'Scanner locked on photon torpedo.'/
X data u_message(2) /'Nemian freighter in tractor beam.'/
X data u_message(5) /'Enemy photon in tractor beam.'/
X data u_message(6) /'Photon torpedo in tractor beam.'/
X data sl_message(1) /'Game put on hold.'/
X data sl_message(2) /'STREK will not start again until another'/
X data sl_message(3) /'key is hit.'/
Xc
Xc statement functions for converting angles to rads
Xc and vice-versa
Xc
X ra(x) = x * pi / 180.0
X de(x) = x * 180.0 / pi
Xc
Xc call STREK_STARTUP to init db and get ship info
Xc
X call strek_startup (user_name,capt_name, nick_name, ship_name,
X & last_score, cum_score, key_file, new_ship)
Xc
Xc call STREK_SCREEN_INIT
Xc
X call strek_screen_init (bitmap_desc, font_3, font_4)
Xc
Xc enable keystroke events
Xc
X call gprenableinput (gprkeystroke, key_set, status)
Xc
Xc startup info panels (4 passes to init everything)
Xc
X do 5 j = 1,4
X call strek_update_panel (0, int(energy), photons, phase,
X & tract_ob, int(xc), int(yc), int(zc),
X & scan, 0, 0, 0, 0, scan_ob)
X 5 continue
Xc
Xc give an introductory message
Xc
X b_message(2) = 'Welcome aboard sir, the bridge is all yours!'
X call strek_message (b_message, 3)
Xc
Xc call clock to get a random number seed
Xc
X call calgetlocaltime (clock)
X seed = abs(clock(3)/33000.0)
Xc
Xc start turn timer
Xc
X call timeclock (timer)
X call calfloatclock (timer, elapsed)
Xc
Xc get a nemian
Xc
X call strek_place_nemian (xc, yc, zc, obx(1), oby(1), obz(1),
X & oazm(1), oangle(1), ospeed(1), seed)
X object(1) = .true.
X odamage(1) = 0.0
Xc
Xc begin event driver loop
Xc
X 10 continue
Xc
Xc check phaser availability
Xc
X if ((.not.phase).and.phase_d) then
X phase_c = phase_c + 1
X if (phase_c.gt.40) then
X phase_d = .false.
X phase = .true.
X end if
X end if
Xc
Xc if nemian is getting too far away then refresh him
Xc
X if (orange(1).gt.9000000.0) object(1) = .false.
Xc
Xc if there's no nemian then get one
Xc
X if (.not.object(1)) then
X call strek_place_nemian (xc, yc, zc, obx(1), oby(1), obz(1),
X & oazm(1), oangle(1), ospeed(1), seed)
X object(1) = .true.
X odamage(1) = 0.0
Xc
Xc check for nemian docking
Xc
X else if ((tr_object.eq.1).and.tract_ob) then
X if (distance(1,0).lt.900.0.and.abs(speed).le.1) then
X score = score + 500
X b_message(2) = s_message(11)
X call strek_message (b_message, 3)
X tract_ob = .false.
X object(1) = .false.
X dock_n = dock_n + 1
X end if
X end if
Xc
Xc check for photon proximity explosions
Xc
X do 20 j = 4,9
X if (object(j)) then
X photon_c(j-3) = photon_c(j-3) + 1
X if (photon_c(j-3).gt.60) object(j) = .false.
X if (j.gt.6) then
X do 30 i = 1,3
X if (object(i).and.(distance(i,j).le.photon_tr(j).and.
X & orange(j).gt.1600.0)) then
X object(j) = .false.
X call strek_photon_damage (distance(i,j), odamage(i),
X & seed, type)
X a_message(1) = ph_message(index(i))
X write (a_message(3),'(a36,a10)') s_message(14),
X & dam_rating(type)
X call strek_message (a_message, 3)
X end if
X 30 continue
X else
Xc
Xc check for nemian hits
Xc
X if (object(1).and.(distance(1,j).lt.photon_tr(j))) then
X if (.not.object(2).or.distance(2,j).gt.900.0) then
X if (.not.object(3).or.distance(3,j).gt.900.0) then
X object(j) = .false.
X call strek_photon_damage (distance(1,j), odamage(1),
X & seed, type)
X end if
X end if
X end if
Xc
Xc check for player ship hits
Xc
X if (orange(j).lt.photon_tr(j)) then
X if (.not.object(2).or.distance(2,j).gt.225.0) then
X if (.not.object(3).or.distance(3,j).gt.225.0) then
X object(j) = .false.
X call strek_photon_damage (orange(j), damage,
X & seed, type)
X write (ap_message(3),'(a42,a10)') s_message(15),
X & dam_rating(type)
X call strek_message (ap_message, 3)
X end if
X end if
X end if
X end if
X end if
X 20 continue
Xc
Xc if enemy ships are alive then move 'em
Xc
X if (object(2).or.object(3)) then
X do 50 j = 2,3
X if (object(j)) then
X call strek_move_enemy (j, obx, oby, obz, oazm, oangle,
X & ospeed, xc, yc, zc, azm, angle,
X & speed, agr(j), object, rox(j),
X & roy(j), roz(j), odamage, pc(j),
X & distance, kling(j), cm(j), cs(j),
X & orange, razm(j), rangle(j),
X & brake(j), damage, photon_c,
X & phase_c, pro_x, pro_y, seed, center)
X end if
X 50 continue
X else if (waited .gt. turns_wait) then
Xc
Xc reset damage totals, pick ship type and aggression levels
Xc
X call strek_enemy_setup (odamage, agr, kling, maxd, object, seed,
X & two, pc)
X j = 2
X k = 3
X if (two) then
X call strek_place_enemy (xc, yc, zc, obx(j), oby(j), obz(j),
X & oazm(j), oangle(j), ospeed(j), seed)
X call strek_place_enemy (xc, yc, zc, obx(k), oby(k), obz(k),
X & oazm(k), oangle(k), ospeed(k), seed)
X else
X call strek_place_enemy (xc, yc, zc, obx(j), oby(j), obz(j),
X & oazm(j), oangle(j), ospeed(j), seed)
X end if
X waited = 0
X else if (waited .eq. 0) then
X call rand (seed)
X turns_wait = seed * 150.0 + 50
X waited = 1
X else
X waited = waited + 1
X end if
Xc
Xc evaluate sum of damages (both photon and phaser) to other objects
Xc
X do 40 j= 1,9
X if (object(j).and.(odamage(j).ge.maxd(j))) then
X if (j.eq.1) then
X ship_n = ship_n + 1
X else if (kling(j)) then
X ship_k = ship_k + 1
X else
X ship_r = ship_r + 1
X end if
X object(j) = .false.
X k_message(1) = d_message(index(j))
X if (j.eq.2.or.j.eq.3) then
X write (k_message(2),'(a27,f10.2)') s_message(12), value(j)
X write (k_message(3),'(a11,a10)') s_message(13), nick_name
X else if (j.eq.1) then
X write (k_message(2),'(a13,f10.2)') s_message(16), value(j)
X write (k_message(3),'(a36,a10)') s_message(17), capt_name
X call rand (seed)
X if (seed.gt.0.5) then
X agr(2) = .false.
X end if
X call rand (seed)
X if (seed.gt.0.5) then
X agr(3) = .false.
X end if
X else
X k_message(2) = k_message(1)
X k_message(1) = ' '
X k_message(3) = ' '
X end if
X call strek_message (k_message, 3)
X score = score + value(j)
X end if
X 40 continue
Xc
Xc process lock on coordinates
Xc
X nav_c = nav_c + 1
X if (lock_on) then
X if (orange(l_object).gt.10000.0.and.nav_c.ge.10) then
X nav_c = 0
X if (speed.lt.0.0) then
X s1 = -speed
X s2 = azm + 180.0
X if (s2.gt.360.0) s2 = s2 - 360.0
X s3 = 360.0 - angle
X reverse = .true.
X else
X s1 = speed
X s2 = azm
X s3 = angle
X reverse = .false.
X end if
X if (s1.gt.1.e-2) then
X num_forward = sqrt(orange(l_object)) / s1
X else
X num_forward = 20
X end if
X j = l_object
X xt1 = -num_forward * ospeed(j) * sin(oazm(j)) *
X & cos(oangle(j)) + obx(j)
X yt1 = num_forward * ospeed(j) * cos(oazm(j)) *
X & cos(oangle(j)) + oby(j)
X zt1 = num_forward * ospeed(j) * sin(oangle(j))
X & + obz(j)
X dx = xt1 - xc
X dy = yt1 - yc
X dz = zt1 - zc
X if (abs(dy).lt.1.0) dy = sign (1.0, dy)
X if (dy.le.0.0) then
X tazm = -de(atan(dx/dy)) + 180.0
X else
X tazm = -de(atan(dx/dy))
X end if
X if (tazm.lt.0.0) tazm = tazm + 360.0
X dist = sqrt(dx**2 + dy**2)
X if (dist.lt.1.0) dist = 1.0
X tangle = de(atan(dz/dist))
Xc
Xc pick smallest angle (needed due to arctan being only in
Xc I and IV quadrants
Xc
X t1 = (tazm - s2)/10.0
X t2 = (tangle - s3)/10.0
X t3 = (tazm - (s2 + 360.0))/10.0
X t4 = (tangle - (s3 + 360.0))/10.0
X t5 = (tazm - (s2 - 360.0))/10.0
X t6 = (tangle - (s3 - 360.0))/10.0
X if (abs(t3).lt.abs(t1)) t1 = t3
X if (abs(t5).lt.abs(t1)) t1 = t5
X if (abs(t4).lt.abs(t2)) t2 = t4
X if (abs(t6).lt.abs(t2)) t2 = t6
X if (reverse) t2 = - t2
Xc
Xc limit rotation angles by max ship ability
Xc
X if (abs(t1).gt.0.6) t1 = sign(0.6, t1)
X if (abs(t2).gt.0.6) t2 = sign(0.6, t2)
Xc
Xc set rotation vars
Xc
X rot_azm(10) = t1
X rot_ang(10) = t2
X end if
X end if
Xc
Xc if rotate then rotate
Xc
X if (rot_azm(r_index).ne.0.0) then
X azm = azm + rot_azm(r_index)
X sa = sin(ra(azm))
X ca = cos(ra(azm))
X end if
X if (rot_ang(r_index).ne.0.0) then
X angle = angle + rot_ang(r_index)
X sp = sin(ra(angle))
X cp = cos(ra(angle))
X end if
X if ((.not.rotate).and.(.not.lock_on)) r_index = 9
Xc
Xc rotate tractored object back to translated galatic coords centered
Xc on ship
Xc
X if (tract_ob.and.tract) then
X if (.not.object(tr_object)) then
X tract_ob = .false.
X b_message(2) = s_message(index(tr_object))
X call strek_message (b_message, 3)
X else
X trazm = trazm + ra(rot_azm(r_index))
X t1 = cos(trazm - ra(azm))
X trangle = trangle + ra(rot_ang(r_index)) * t1
X j = tr_object
X trx = rox(j)*ca - roy(j)*sa*cp + roz(j)*sa*sp + xc
X try = rox(j)*sa + roy(j)*ca*cp - roz(j)*ca*sp + yc
X trz = roy(j)*sp + roz(j)*cp + zc
X end if
X end if
Xc
Xc check that scan object still exists
Xc
X if (.not.(object(scan_ob)).and.(scan_ob.ge.4)) then
X scan_ob = 1
X b_message (2) = s_message(10)
X call strek_message (b_message, 3)
X end if
Xc
Xc check that nav lock on object still exists
Xc
X if (lock_on.and.((.not.object(l_object).or.orange(l_object).lt.
X & 10000.0).or.(.not.scan))) then
X lock_on = .false.
X b_message(2) = 'Navigation lock on lost.'
X call strek_message (b_message, 3)
X r_index = 9
X end if
Xc
Xc apply damage to the player's ship
Xc
X call strek_assess_damage (d_pct, damage, scan, tract, phase,
X & energy, seed)
Xc
Xc get a key if one has been struck
Xc
X unobscured = gprcondeventwait (event_type, key, c_pos, status)
X if (event_type.ne.gprnoevent) then
X call strek_interpret_key (key)
Xc
Xc process a speed key
Xc
X if (key.eq.'a') then
X speed = speed + 0.5
X if (speed.gt.5.0) then
X speed = 5.0
X b_message(2) = s_message(9)
X call strek_message (b_message, 3)
X end if
X else if (key.eq.'s') then
X speed = speed - 0.5
X if (speed.lt.-5.0) then
X speed = -5.0
X b_message(2) = s_message(9)
X call strek_message (b_message, 3)
X end if
X end if
Xc
Xc process a rotate key
Xc
X if (.not.lock_on) then
X if (key.eq.'m') then
X r_index = 9
X else if (key.eq.'b') then
X rotate = .not.rotate
X else
X if (.not.rotate) then
X if (key.eq.'u') then
X r_index = 1
X else if (key.eq.'j') then
X r_index = 2
X else if (key.eq.'h') then
X r_index = 3
X else if (key.eq.'n') then
X r_index = 4
X end if
X else
X if (key.eq.'u') then
X r_index = 5
X else if (key.eq.'j') then
X r_index = 6
X else if (key.eq.'h') then
X r_index = 7
X else if (key.eq.'n') then
X r_index = 8
X end if
X end if
X end if
X end if
Xc
Xc process a tractor beam key
Xc
X if ((key.eq.'t'.and.tract).and.(.not.tract_ob)) then
X call strek_number_objects (pos_store, ran_store, object,
X & .true.)
X call strek_message (t_message, 3)
X i = 0
X 60 continue
X i = i + 1
X unobscured = gprcondeventwait (event_type, t_key, c_pos,
X & status)
X if (event_type.ne.gprnoevent.or.i.gt.3000) goto 70
X goto 60
X 70 continue
X call strek_number_objects (pos_store, ran_store, object,
X & .false.)
X if (event_type.ne.gprnoevent) then
X call strek_interpret_key (t_key)
X if ((t_key.eq.'1').or.((t_key.ge.'4').and.(t_key.le.'9')))
X & then
X read (t_key,'(i1)') tr_object
X if (object(tr_object).and.orange(tr_object).lt.9.0e4) then
X tract_ob = .true.
X j = tr_object
X trx = obx(j)
X try = oby(j)
X trz = obz(j)
X trazm = oazm(j)
X trangle = oangle(j)
X trdist = orange(j)
X b_message(2) = u_message(index(j))
X call strek_message (b_message, 3)
X end if
X end if
X end if
X end if
Xc
Xc process a drop tractor key
Xc
X if (key.eq.'r'.and.tract_ob) then
X tract_ob = .false.
X oazm(tr_object) = trazm
X oangle(tr_object) = trangle
X b_message(2) = s_message(7)
X call strek_message (b_message, 3)
X end if
Xc
Xc process an damage information key
Xc
X if (key.eq.'i') then
X call strek_damage_info (d_pct, capt_name, nick_name)
X end if
Xc
Xc process a photon key
Xc
X if (key.eq.'f'.and.(photons.ge.1)) then
X call strek_find_free_ob (object, 7, j, found)
X if (found) then
X object(j) = .true.
X photon_c(j-3) = 0
X photons = photons - 1
X obx(j) = xc
X oby(j) = yc
X obz(j) = zc
X oazm(j) = ra(azm)
X oangle(j) = ra(angle)
X ospeed(j) = 10
X b_message(2) = s_message(8)
X call strek_message (b_message, 3)
X end if
X end if
Xc
Xc process a phaser key
Xc
X if (((key.eq.'p').and.(phase)).and.(energy.gt.30.0)) then
X call strek_number_objects (pos_store, ran_store, object,
X & .true.)
X call strek_message (p_message, 3)
X i = 0
X 80 continue
X i = i + 1
X unobscured = gprcondeventwait (event_type, t_key, c_pos,
X & status)
X if (event_type.ne.gprnoevent.or.i.gt.3000) goto 90
X goto 80
X 90 continue
X call strek_number_objects (pos_store, ran_store, object,
X & .false.)
X if (event_type.ne.gprnoevent) then
X call strek_interpret_key (t_key)
X if ((t_key.ge.'0').and.(t_key.le.'9')) then
X read (t_key,'(i1)') ph_object
X if (object(ph_object).and.(orange(ph_object).lt.250000.0))
X & then
X if ((pro_x(ph_object).le.800.and.pro_x(ph_object).ge.
X & 100).and.(pro_y(ph_object).le.700.and.
X & pro_y(ph_object).ge.100)) then
X call strek_draw_phasers (int(pro_x(ph_object)),
X & int(pro_y(ph_object)))
X energy = energy - 30.0
X phase_d = .true.
X phase_c = 0
X phase = .false.
Xc
Xc do damage to other ship
Xc
X call strek_phaser_fire (orange(ph_object), seed,
X & odamage(ph_object), type)
X a_message(1) = ps_message(index(ph_object))
X write (a_message(3),'(a36,a10)') s_message(14),
X & dam_rating(type)
X call strek_message (a_message, 3)
X end if
X end if
X end if
X end if
X end if
Xc
Xc process a explode radius key
Xc
X if (key.eq.'e') then
X call strek_message (e_message, 3)
X i = 0
X100 continue
X i = i + 1
X unobscured = gprcondeventwait (event_type, t_key, c_pos,
X & status)
X if (event_type.ne.gprnoevent.or.i.gt.5000) goto 110
X goto 100
X110 continue
X if (event_type.ne.gprnoevent) then
X call strek_interpret_key (t_key)
X if ((t_key.gt.'0').and.(t_key.le.'6')) then
X read (t_key,'(i1)') option
X t1 = 10.0 + 5.0*option
X photon_tr(7) = t1**2
X photon_tr(8) = photon_tr(7)
X photon_tr(9) = photon_tr(7)
X end if
X end if
X end if
Xc
Xc change scanner object keys
Xc
X if (key.ge.'0'.and.key.le.'9') then
X read (key,'(i1)') item
X if (object(item)) then
X scan_ob = item
X b_message(2) = sc_message(index(item))
X call strek_message (b_message, 3)
X end if
X end if
Xc
Xc process a nav lock on key
Xc
X if (key.eq.'l'.and.scan) then
X call strek_message (t_message, 3)
X i = 0
X120 continue
X i = i + 1
X unobscured = gprcondeventwait (event_type, t_key, c_pos,
X & status)
X if (event_type.ne.gprnoevent.or.i.gt.5000) goto 130
X goto 120
X130 continue
X if (event_type.ne.gprnoevent) then
X call strek_interpret_key (t_key)
X if (t_key.ge.'0'.and.t_key.le.'3') then
X read (t_key,'(i1)') l_object
X if (object(l_object).and.orange(l_object).gt.22500.0) then
X lock_on = .true.
X b_message(2) = l_message(index(l_object))
X call strek_message (b_message, 3)
X r_index = 10
X nav_c = 10
X end if
X end if
X end if
X end if
Xc
Xc process a nav lock drop key
Xc
X if (key.eq.'o'.and.lock_on) then
X lock_on = .false.
X b_message(2) = 'Navigation lock on dropped.'
X call strek_message (b_message, 3)
X r_index = 9
X end if
Xc
Xc process a dock key
Xc
X if ((key.eq.'d'.and.orange(0).lt.900.0).and.(abs(speed).lt.1))
X & then
X call strek_dock (d_pct, score, user_name,
X & capt_name, nick_name,
X & ship_name, cum_score, key_file, new_ship)
X stop
X end if
Xc
Xc process a current score key
Xc
X if (key.eq.'c') then
X write (r_message(1),'(a15,a30)') r_message(1), ship_name
X write (r_message(3),'(i8,i10,i9,i16,2i7)') ship_k, ship_r,
X & ship_n, dock_n, score, cum_score
X call strek_message (r_message, 3)
X end if
Xc
Xc process a clear com window key
Xc
X if (key.eq.'z') then
X b_message(2) = ' '
X call strek_message (b_message, 3)
X end if
Xc
Xc process a sleep until key
Xc
X if (key.eq.'/') then
X call strek_message (sl_message, 3)
X125 continue
X unobscured = gprcondeventwait (event_type, t_key, c_pos,
X & status)
X if (event_type.ne.gprnoevent) goto 135
X goto 125
X135 continue
X b_message(2) = ' '
X call strek_message (b_message, 3)
X end if
Xc
Xc end parsing routines
Xc
X end if
Xc
Xc put angles back to normal (between 0 and 360)
Xc
X if (azm.lt.0.0) azm = azm + 360.0
X if (azm.ge.360.0) azm = azm - 360.0
X if (angle.lt.0.0) angle = angle + 360.0
X if (angle.ge.360.0) angle = angle - 360.0
Xc
Xc add engine energy output
Xc
X energy = energy + .35 * (d_pct(1) + d_pct(2))
Xc
Xc subtract off energy due to speed and rotation
Xc
X energy = energy - abs(speed)/7.5 - rot_cost(r_index)
Xc
Xc subtract energy due to tractors
Xc
X if (tract_ob) then
X energy = energy - sqrt(trdist)/60.0*tr_cost(tr_object) +0.1
X end if
Xc
Xc limit energy by battery percent
Xc
X check = d_pct(4)*1000.0
X if (energy.gt.check) energy = check
Xc
Xc if out of energy start (or continue) death march
Xc
X if (energy.lt.0.0) then
X num_times = num_times + 1
X call strek_no_energy (num_times, user_name,
X & capt_name, nick_name,
X & ship_name, key_file, score, cum_score,
X & new_ship)
X else
X num_times = 0
X end if
Xc
Xc process new coordinates
Xc
X tempx = xc
X tempy = yc
X tempz = zc
X xc = -sa * cp * speed + xc
X yc = ca * cp * speed + yc
X zc = sp * speed + zc
X do 150 j = 0,9
X if (object(j)) then
X if (j .ne. 0) then
X soa(j) = sin(oazm(j))
X coa(j) = cos(oazm(j))
X sop(j) = sin(oangle(j))
X cop(j) = cos(oangle(j))
X obx(j) = -soa(j) * cop(j) * ospeed(j) + obx(j)
X oby(j) = coa(j) * cop(j) * ospeed(j) + oby(j)
X obz(j) = sop(j) * ospeed(j) + obz(j)
X end if
X xt(j) = obx(j) - xc
X yt(j) = oby(j) - yc
X zt(j) = obz(j) - zc
X orange(j) = xt(j)**2 + yt(j)**2 + zt(j)**2
X end if
X150 continue
Xc
Xc update tractored object
Xc
X if (tract_ob.and.tract) then
X trx = trx - tempx + xc
X try = try - tempy + yc
X trz = trz - tempz + zc
X j = tr_object
X obx(j) = trx
X oby(j) = try
X obz(j) = trz
X oazm(j) = trazm
X oangle(j) = trangle
X xt(j) = obx(j) - xc
X yt(j) = oby(j) - yc
X zt(j) = obz(j) - zc
X orange(j) = xt(j)**2 + yt(j)**2 + zt(j)**2
X trdist = orange(j)
X end if
Xc
Xc get object to object distances when both exist
Xc
X do 160 j = 0,9
X if (object(j)) then
X do 170 i = 1,3
X if (object(i).and.i.ne.j) then
X distance(i,j) = (obx(i) - obx(j))**2 + (oby(i) -
X & oby(j))**2 + (obz(i) - obz(j))**2
X end if
X170 continue
X end if
X160 continue
Xc
Xc rotate objects into shipocentric coordinates
Xc
X do 180 j = 0,9
X if (object(j)) then
X rox(j) = xt(j) * ca + yt(j) * sa
X roy(j) = -xt(j) * sa * cp + yt(j) * ca * cp + zt(j) * sp
X roz(j) = xt(j) * sa * sp - yt(j) * ca * sp + zt(j) * cp
Xc
Xc project shiopcentric coordinates to screen coords
Xc
X if (roy(j).gt.1.0) then
X pro_x(j) = 450.0 + (rox(j)/roy(j)) * 350.0
X pro_y(j) = 400.0 - (roz(j)/roy(j)) * 350.0
X if (abs(pro_x(j)).gt.3000.0) pro_x(j) = 1000.0
X if (abs(pro_y(j)).gt.3000.0) pro_y(j) = 1000.0
X else
X pro_x(j) = 1000.0
X pro_y(j) = 1000.0
X if (j .eq. 2) then
X center(1) = 1000
X center(2) = 1000
X end if
X end if
Xc
Xc fill temporary array for use in scanner windows
Xc
X pos_store(j,1) = pro_x(j)
X pos_store(j,2) = pro_y(j)
X end if
X180 continue
Xc
Xc erase old objects
Xc
X call gprsetdrawvalue (0, status)
X if (refresh) then
X call strek_scanner (rox, roy, roz, object, .false.)
X end if
X if (plot(0)) then
X call strek_starbase (xc, yc, zc, ca, cp, sa, sp, .false.)
X end if
X do 190 j = 1, 9
X if (plot(j)) then
X goto (191, 192, 193, 194, 195, 196, 197, 198, 199) j
X191 continue
X call strek_nemian (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false., soa(j), coa(j),
X & sop(j), cop(j))
X goto 190
X192 continue
X if (kling(j)) then
X call strek_klingon (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .false., center,
X & soa(j), coa(j), sop(j), cop(j))
X else
X call strek_romulan_1 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .false., soa(j),
X & coa(j), sop(j), cop(j))
X end if
X goto 190
X193 continue
X call strek_romulan_2 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .false., soa(j),
X & coa(j), sop(j), cop(j))
X goto 190
X194 continue
X call strek_photon_1 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X195 continue
X call strek_photon_2 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X196 continue
X call strek_photon_3 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X197 continue
X call strek_photon_4 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X198 continue
X call strek_photon_5 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X199 continue
X call strek_photon_6 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
X & sa, cp, sp, .false.)
X goto 190
X end if
X190 continue
Xc
Xc update screen objects
Xc
X call gprsetdrawvalue (1, status)
X if (refresh) then
X call strek_scanner (rox, roy, roz, object, .true.)
X end if
X refresh = .not. refresh
X do 200 j = 0,9
X plot(j) = .false.
X ran_store(j) = orange(j)
X if (object(j).and.orange(j).lt.4000000.0) then
X if ((pro_x(j).lt.900.0).and.(pro_x(j).gt.0.0)) then
X if ((pro_y(j).lt.800.0).and.(pro_y(j).gt.0.0)) then
X plot(j) = .true.
X if (j.eq.0) then
X call strek_starbase (xc, yc, zc, ca, cp, sa, sp,
X & .true.)
X else
X goto (201, 202, 203, 204, 205, 206, 207, 208, 209) j
X201 continue
X call strek_nemian (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true., soa(j),
X & coa(j), sop(j), cop(j))
X goto 200
X202 continue
X if (kling(j)) then
X call strek_klingon (xc, yc, zc, obx(j), oby(j),
X & obz(j), ca, sa, cp, sp, .true.,
X & center, soa(j), coa(j), sop(j),
X & cop(j))
X else
X call strek_romulan_1 (xc, yc, zc, obx(j), oby(j),
X & obz(j), ca, sa, cp, sp, .true.,
X & soa(j), coa(j), sop(j), cop(j))
X end if
X goto 200
X203 continue
X call strek_romulan_2 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true., soa(j),
X & coa(j), sop(j), cop(j))
X goto 200
X204 continue
X call strek_photon_1 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X205 continue
X call strek_photon_2 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X206 continue
X call strek_photon_3 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X207 continue
X call strek_photon_4 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X208 continue
X call strek_photon_5 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X209 continue
X call strek_photon_6 (xc, yc, zc, obx(j), oby(j), obz(j),
X & ca, sa, cp, sp, .true.)
X goto 200
X end if
X end if
X end if
X end if
X200 continue
Xc
Xc draw center of the screen crosshairs
Xc
X call strek_x_hairs
Xc
Xc update panels
Xc
X if (scan) then
X txc = nint(rox(scan_ob))
X tyc = nint(roy(scan_ob))
X tzc = nint(roz(scan_ob))
X trange = nint(sqrt(orange(scan_ob)))
X end if
X rate = speed * 2
X call strek_update_panel (rate, int(energy), photons, phase,
X & tract_ob, int(xc), int(yc), int(zc),
X & scan, txc, tyc, tzc, trange, scan_ob)
X call strek_flashers (object, lock_on, energy, bitmap_desc)
Xc
Xc evaluate the turn duration, if it is shorter than the
Xc minimum (which is .06 seconds) then request it again.
Xc Since this call is slow it makes an ideal timer.
Xc
X210 continue
X call timeclock (timer)
X call calfloatclock (timer, turn)
X duration = turn - elapsed
X if (duration.gt.0.06) then
X elapsed = turn
Xc goto 10
X end if
X timer(1) = 0
X timer(2) = 0
X timer(3) = 15000
X call timewait (timerelative, timer, status)
X goto 10
Xc goto 210
X end
E!O!F! xstrek/f_changed/strek_main.f
echo xstrek/f_changed/strek_prune_db.f 1>&2
sed -e 's/^X//' > xstrek/f_changed/strek_prune_db.f <<'E!O!F! xstrek/f_changed/strek_prune_db.f'
X program strek_prune_info
Xc
Xc *******************************************************************
Xc ***** *****
Xc ***** STAR TREK VERSION 3.0 *****
Xc ***** *****
Xc ***** written by *****
Xc ***** *****
Xc ***** Justin S. Revenaugh *****
Xc ***** *****
Xc ***** 7/87 *****
Xc ***** *****
Xc ***** Massachussetts Institute of Technology *****
Xc ***** Department of Earth, Atmospheric and Planetary Science *****
Xc ***** *****
Xc *******************************************************************
Xc
Xc STREK_PRUNE_INFO helps weed out retired or unused ships from the
Xc ship's registry (STREK_INFO). Used occasionally it should prevent
Xc this file from growing too huge.
Xc
Xc version 1
Xc -jsr 8/85
Xc
X parameter (k=1000)
X integer*2 clock(6)
X integer*4 last_score(k), cum_score(k), ship_avail(k,3)
X integer*4 ship_retired(k)
X character ship_name(k)*30, user_name(k)*10
X character capt_name(k)*10, nick_name(k)*10
X character*256 key_file(k)
Xc
Xc get local date
Xc
X call caldecodelocaltime (clock)
Xc
Xc open up file and read num_lines
Xc
X open (unit=1, file='/usr/lib/X11/xstrek/strek_info',
X & access='direct',form =
X & 'unformatted', recl=1000)
X read (1,rec=1) num_lines
X do 10 j = 1,num_lines
X read (1,rec=j+1) ship_name(j), user_name(j),
X & capt_name(j), nick_name(j),
X & key_file(j), (ship_avail(j,i), i=1,3),
X & last_score(j), cum_score(j), ship_retired(j)
X 10 continue
X num_kept = 0
X do 20 j = 1,num_lines
X if (ship_retired(j).ne.1) then
X check = clock(2) - 2
X year = clock(1) - 1
X month = clock(2) - 10
X if ((ship_avail(j,1).ge.clock(1).and.ship_avail(j,2).gt.check)
X & .or.(ship_avail(j,1).eq.year.and.month.gt.0)) then
X if (ship_name(j).ne.' ') then
X num_kept = num_kept + 1
X write (1,rec=num_kept+1) ship_name(j), user_name(j),
X & capt_name(j),
X & nick_name(j), key_file(j),
X & (ship_avail(j,i),i=1,3),
X & last_score(j), cum_score(j),
X & ship_retired(j)
X end if
X end if
X end if
X 20 continue
Xc
Xc erase all former ships
Xc
X do 30 j = num_kept + 2, num_lines + 1
X write (1,rec=j)
X 30 continue
Xc
Xc rewrite the number of ships in the registry
Xc
X write (1,rec=1) num_kept
X close(1)
X stop
X end
X
E!O!F! xstrek/f_changed/strek_prune_db.f
echo xstrek/f_changed/strek_random_subs.f 1>&2
sed -e 's/^X//' > xstrek/f_changed/strek_random_subs.f <<'E!O!F! xstrek/f_changed/strek_random_subs.f'
X subroutine strek_assess_damage (d_pct, damage, scan, tract, phase,
X & energy, seed)
Xc
Xc *******************************************************************
Xc ***** *****
Xc ***** STAR TREK VERSION 3.0 *****
Xc ***** *****
Xc ***** written by *****
Xc ***** *****
Xc ***** Justin S. Revenaugh *****
Xc ***** *****
Xc ***** 7/87 *****
Xc ***** *****
Xc ***** Massachussetts Institute of Technology *****
Xc ***** Department of Earth, Atmospheric and Planetary Science *****
Xc ***** *****
Xc *******************************************************************
X
Xc
Xc STREK_ASSESS_DAMAGE assesses enemy damage done to the player's
Xc ship. If a damage percent reaches 100 (i.e. d_pct = 0.0) then
Xc the associated function (if any) is deactivated.
Xc
Xc
X real*4 d_pct(6), seed, energy, damage
X logical scan, tract, phase
Xc
Xc adjust energy
Xc
X if (damage.gt.0.0) then
X energy = energy - damage/10.0
Xc
Xc apply damage
Xc
X do 10 j = 1,6
X call rand (seed)
X d_pct(j) = d_pct(j) - seed * damage * 0.0025
X if (d_pct(j).lt.0.0) d_pct(j) = 0.0
X 10 continue
Xc
Xc check for function loss
Xc
X if (d_pct(3).eq.0.0) phase = .false.
X if (d_pct(5).eq.0.0) scan = .false.
X if (d_pct(6).eq.0.0) tract = .false.
X damage = 0.0
X end if
X return
X end
X
X
X
X
X
X subroutine strek_photon_damage (distance, damage, seed, type)
Xc
Xc STREK_PHOTON_DAMAGE calculates the damage do to anyone's
Xc photons hitting anyone.
Xc
Xc version 1
Xc -jsr 8/85
Xc
X integer*4 type
X real*4 distance, damage, seed, mult
Xc
Xc using distance figure damage. Falls off as 1/sqrt(distance)
Xc instead as 1/distance (which is physically correct, but destroys
Xc game balance). Type is the rating of damage (mild - severe).
Xc
X call rand (seed)
X if (seed.lt.0.80) then
X mult = 0.80
X else
X mult = seed
X end if
X t1 = 100.0 / sqrt(sqrt(distance) + 3.0) * mult
X damage = t1 + damage
X if (t1.lt.5.0) type = 1
X if (t1.ge.5.0.and.t1.lt.15.0) type = 2
X if (t1.ge.15.0) type = 3
X return
X end
X
X
X
X
X subroutine strek_phaser_damage (range, damage, seed, target)
Xc
Xc STREK_PHASER_DAMAGE computes klingon phaser damage
Xc
Xc version 1
Xc -jsr 8/85
Xc
X integer*4 type
X real*4 range, damage, seed
X character*80 message(3), text
X character*10 dam_rating(3)
X logical target
X save message, dam_rating, text
X data message(1) /'Ship hit by enemy phaser fire.'/
X data message(2) /' '/
X data message(3) /' '/
X data text /'Repair parties report that the damage was '/
X data dam_rating(1) /'light'/
X data dam_rating(2) /'moderate'/
X data dam_rating(3) /'heavy'/
Xc
Xc figure damage
Xc
X
X t4 = 0.0
X call rand (seed)
X if (seed.le.80) then
X call rand (seed)
X t1 = amax1 (10.0, sqrt(range))
X t2 = 15.0 - .075 * t1
X t3 = seed*0.2 + 0.8
X t4 = amax1 (0.0, t2) * t3
X damage = damage + t4
X end if
Xc
Xc write damage message
Xc
X if (target) then
X type = 1
X if (t4.lt.5.0) type = 1
X if (t4.ge.5.0.and.t4.lt.15.0) type = 2
X if (t4.ge.15.0) type = 3
X write (message(3), '(a42, a10)') text, dam_rating(type)
X call strek_message (message, 3)
X end if
X return
X end
X
X
X
X
X
X
X subroutine strek_phaser_fire (range, seed, damage, type)
Xc
Xc STREK_PHASER_FIRE evaluates the damage done by the players
Xc phasers to all other objects.
Xc
Xc version 1
Xc - jsr 8/85
Xc
X integer*4 type
X real*4 range, damage, seed
Xc
X call rand (seed)
X if (seed.le.80) then
X call rand (seed)
X t3 = seed*0.2 + 0.8
X t1 = amax1(10.0, sqrt(range))
X t2 = 25.0 - .075 * t1
X t2 = amax1 (0.0, t2) * t3
X damage = damage + t2
X end if
X if (t2.lt.5) type = 1
X if (t2.ge.5.and.t2.lt.15) type = 2
X if (t2.ge.15) type = 3
X return
X end
X
X
X
X
X
X
Xc subroutine rand (x)
Xc
Xc RAND is a fast pseudo-random number generator, with a
Xc unique sequence of 566927 numbers. X must be between
Xc 0 and 1 ( (0,1] actually ).
Xc
Xc version 1
Xc - jsr 8/85
Xc
Xc integer*4 k, j, m, ix, irand
Xc real*4 x, rm
Xc save k, j, m, rm
Xc data k, j, m, rm / 5701, 3612, 566927, 566927.0/
Xc ix = int (x * rm)
Xc irand = mod (j * ix + k, m)
Xc x = (real (irand) + 0.5) / rm
Xc return
Xc end
X
X
X
E!O!F! xstrek/f_changed/strek_random_subs.f
exit
=====
@work: | Matthias Pfuetzner | @home:
ZGDV, Wilhelminenstrasse 7 | 6100 Darmstadt, FRG | Lichtenbergstrasse 73
+49 6151 155-164 or -101 \ <- Tel.nr. -> / +49 6151 75717
pfuetzner@agd.fhg.de pfuetzner@zgdvda.UUCP XBR1YD3U@DDATHD21.BITNET
--
Dan Heller
------------------------------------------------
O'Reilly && Associates ZipCode Software
Senior Writer President
argv@ora.com argv@zipcode.com