program strek_main
c
c    *******************************************************************
c    *****                                                         *****
c    *****                STAR TREK VERSION 3.0                    *****
c    *****                                                         *****
c    *****                     written by                          *****
c    *****                                                         *****
c    *****                Justin S. Revenaugh                      *****
c    *****                                                         *****
c    *****                       7/87                              *****
c    *****                                                         *****
c    *****        Massachussetts Institute of Technology           *****
c    *****  Department of Earth, Atmospheric and Planetary Science *****
c    *****                                                         *****
c    *******************************************************************
c     
c    STREK_MAIN is the main calling code for the STREK system.
c    It handles the database startup calls, graphics init call,
c    the screen update - resolve - key request sequence.
c    When the ship docks or dies it updates the database.
c
c    version 2.0
c
c % include '/sys/ins/base.ins.ftn'
c % include '/sys/ins/gpr.ins.ftn'
c % include '/sys/ins/smdu.ins.ftn'
c % include '/sys/ins/time.ins.ftn'
c % include '/sys/ins/cal.ins.ftn'
      logical gprcondeventwait
c
c    STREK declarations
c
      parameter (pi = 3.141592653)
      integer*2 font_3, font_4, clock(3), timer(3), wait(3), center(2)
      integer*2 event_type, c_pos(2), key_set(16)
      integer*4 status, last_score, cum_score, photons, waited
      integer*4 photon_c(6), r_index, bitmap_desc, scan_ob, turns_wait
      integer*4 ph_object, tr_object, pos_store(0:9,2)
      integer*4 option, phase_c, score, index(0:9), item, type, l_object
      integer*4 txc, tyc, tzc, trange, rate, cm(3), cs(3), pc(3)
      integer*4 ship_k, ship_r, ship_n, dock_n
c
c   real variables (all ship position data)
c
      real*4 trx, try, trz, trazm, trangle, trdist, tr_cost(0:9)
      real*4 rot_azm(10), rot_ang(10), rot_cost(10), rox(0:9)
      real*4 roy(0:9), roz(0:9), pro_x(0:9), pro_y(0:9), xt(0:9)
      real*4 yt(0:9), zt(0:9), xc, yc, zc, azm, value(9)
      real*4 angle, obx(0:9), oby(0:9), obz(0:9), oazm(0:9)
      real*4 oangle(0:9), ospeed(0:9), orange(0:9), speed, energy
      real*4 distance(3,0:9), odamage(0:9), d_pct(6), seed
      real*4 damage, maxd(9), photon_tr(4:9), razm(3), rangle(3)
      real*4 brake(3), ran_store(0:9), soa(9), coa(9), sop(9), cop(9)
      real*8 elapsed, turn, duration
c
c    message strings
c
      character user_name*10
      character capt_name*10, nick_name*10, ship_name*30
      character*1 key, t_key, dam_rating(3)*10, means(90)
      character*80 message(3), t_message(3), s_message(17)
      character*80 b_message(3), p_message(3), u_message(6)
      character*80 sc_message(6), d_message(6), k_message(3)
      character*80 ph_message(6), a_message(3), ps_message(6)
      character*80 ap_message(3), l_message(6), r_message(3)
      character*80 e_message(3), sl_message(3)
      character*256 key_file
c
c    logical toggles for objects
c
      logical input_event, new_ship, scan, tract, phase, found
      logical tract_ob, rotate, object(0:9), kling(3), phase_d
      logical plot(0:9), two, agr(3), lock_on, reverse, unobscured
      logical refresh
c
c    key interpretation common
c
      common /key_defs/ means
c
c    data for STREK 
c
      data index /1, 2, 3, 4, 5, 5, 5, 6, 6, 6/
      data key_set /16 * 16#ffff/
      data ship_k, ship_r, ship_n, dock_n/4*0/
      data c/0/
      data waited, turns_wait / 0, 0/
      data cm, cs, pc /3*0, 3*0, 3*3/
      data rot_azm /0.0, -2.0, 2.0, 0.0, 0.0, -1.0, 1.0, 0.0, 2*0.0/
      data rot_ang /2.0, 0.0, 0.0, -2.0, 1.0, 0.0, 0.0, -1.0, 2*0.0/
      data rot_cost, rotate /8*.25, 0.0, 0.25, .true./
      data r_index, photon_tr /9, 6*900.0/
      data xc, yc, zc, azm, angle /0.0, -50.0, 0.0, 0.0, 0.0/
      data photons, speed, energy, damage /20, 0.0, 1000.0, 0.0/
      data d_pct, odamage /6*1.0, 10*0.0/
      data tr_cost /0.0, 0.4, 2.0, 2.0, 6*1.0/
      data obx(0), oby(0), obz(0)/3*0.0/
      data ospeed, oangle, oazm /10*0.0, 10*0.0, 10*0.0/
      data score, maxd, value /0, 5.0, 2*0.0, 6*12.5, -200.0, 2*300.0, 
     &                         6*0.0/
      data sa, ca, sp, cp /0.0, 1.0, 0.0, 1.0/
      data rox, roy, roz / 30 * 0.0/
      data scan, tract, phase, phase_d/3*.true., .false./
      data tract_ob, scan_ob, tr_object /.false., 1, 0/
      data object, plot /.true., 9*.false., 10*.false./
      data lock_on, refresh /.false., .true./
      data dam_rating /'light', 'moderate', 'heavy'/
      data t_message /'Which should I lock onto captain?',
     &                'Input number of object to lock,'
     &               ,'any other input = No lock on '/
      data p_message /'Phaser control',
     &                'Input number of object to lock phasers on,'
     &               ,'any other input = No phaser lock on '/
      data e_message  /'Photon Torpedo Trigger Radius Options',
     &                '1 = 15  2 = 20  3 = 25  4 = 30  5 = 35  6 = 40',
     &                'Enter option.'/
      data r_message  /'Statistics for ',
     &                 'Klingons  Romulans  Nemians  Nemians Docked  Sco
     &re  Total', ' '/
      data a_message, b_message, k_message /9*' '/
      data ap_message(1) /'Ship hit by enemy photon!'/
      data ap_message(2) /' '/
      data d_message(1)  /' '/
      data d_message(2)  /'Nemian freighter destroyed.'/
      data d_message(3)  /'Enemy spacecraft destroyed.'/
      data d_message(4)  /'Second enemy spacecraft destroyed.'/
      data d_message(5)  /'Enemy photon torpedo destroyed.'/
      data d_message(6)  /'Photon torpedo destroyed.'/
      data l_message(1)  /'Navigation lock on star base.'/
      data l_message(2)  /'Navigation lock on Nemian freighter.'/
      data l_message(3)  /'Navigation lock on enemy spacecraft.'/
      data l_message(4)  /'Navigation lock on second enemy spacecraft.'/
      data ph_message(2) /'Nemian freighter hit by photon torpedo.'/
      data ph_message(3) /'Enemy ship hit by photon torpedo.'/
      data ph_message(4) /'Enemy ship hit by photon torpedo.'/
      data ps_message(2) /'Nemian freighter hit by phaser fire.'/
      data ps_message(3) /'Enemy ship hit by phaser fire.'/
      data ps_message(4) /'Enemy ship hit by phaser fire.'/
      data ps_message(5) /'Enemy Photon torpedo hit by phaser fire.'/
      data ps_message(6) /'Photon torpedo hit by phaser fire.'/
      data s_message(2)  /'Tractor beam on Nemian freighter dropped.'/
      data s_message(5)  /'Tractor beam on enemy photon dropped.'/
      data s_message(6)  /'Tractor beam on photon torpedo dropped.'/
      data s_message(7)  /'Tractor beam lock on dropped.'/
      data s_message(8)  /'Photon torpedo launched sir.'/
      data s_message(9)  /'I''m giving it all she''s got captain.'/
      data s_message(10) /'Scanner lock on lost.'/
      data s_message(11) /'Nemian freighter docked at star base.'/
      data s_message(12) /'Score for destroying ship: '/
      data s_message(13) /'Good going '/
      data s_message(14) /'Scanners report that the damage was '/
      data s_message(15) /'Repair parties report that the damage was '/
      data s_message(16) /'Points lost '/
      data s_message(17) /'It''s your job to defend the Nemians '/
      data sc_message(1) /'Scanner locked on starbase.'/
      data sc_message(2) /'Scanner locked on Nemian freighter.'/
      data sc_message(3) /'Scanner locked on enemy ship.'/
      data sc_message(4) /'Scanner locked on second enemy ship.'/
      data sc_message(5) /'Scanner locked on enemy photon.'/
      data sc_message(6) /'Scanner locked on photon torpedo.'/
      data u_message(2)  /'Nemian freighter in tractor beam.'/
      data u_message(5)  /'Enemy photon in tractor beam.'/
      data u_message(6)  /'Photon torpedo in tractor beam.'/
      data sl_message(1) /'Game put on hold.'/
      data sl_message(2) /'STREK will not start again until another'/
      data sl_message(3) /'key is hit.'/
c
c    statement functions for converting angles to rads
c    and vice-versa
c
      ra(x) = x * pi / 180.0
      de(x) = x * 180.0 / pi
c
c    call STREK_STARTUP to init db and get ship info
c
      call strek_startup (user_name,capt_name, nick_name, ship_name, 
     &                    last_score, cum_score, key_file, new_ship)
c
c    call STREK_SCREEN_INIT 
c
      call strek_screen_init (bitmap_desc, font_3, font_4)
c
c    enable keystroke events
c
      call gprenableinput (gprkeystroke, key_set, status)
c
c    startup info panels (4 passes to init everything)
c
      do 5 j = 1,4
        call strek_update_panel (0, int(energy), photons, phase, 
     &                           tract_ob, int(xc), int(yc), int(zc),
     &                           scan, 0, 0, 0, 0, scan_ob)
 5    continue
c
c    give an introductory message
c
      b_message(2) = 'Welcome aboard sir, the bridge is all yours!'
      call strek_message (b_message, 3)
c
c    call clock to get a random number seed
c
      call calgetlocaltime (clock)
      seed = abs(clock(3)/33000.0)
c
c    start turn timer
c
      call timeclock (timer)
      call calfloatclock (timer, elapsed)
c
c    get a nemian
c
      call strek_place_nemian (xc, yc, zc, obx(1), oby(1), obz(1),
     &                         oazm(1), oangle(1), ospeed(1), seed)
      object(1) = .true.                           
      odamage(1) = 0.0
c
c    begin event driver loop
c
 10   continue
c
c    check phaser availability
c
      if ((.not.phase).and.phase_d) then
        phase_c   = phase_c + 1
        if (phase_c.gt.40) then
          phase_d = .false.
          phase   = .true.
        end if
      end if
c
c    if nemian is getting too far away then refresh him
c
      if (orange(1).gt.9000000.0) object(1) = .false.
c
c    if there's no nemian then get one
c
      if (.not.object(1)) then
        call strek_place_nemian (xc, yc, zc, obx(1), oby(1), obz(1),
     &                           oazm(1), oangle(1), ospeed(1), seed)
        object(1) = .true.                           
        odamage(1) = 0.0
c
c    check for nemian docking
c
      else if ((tr_object.eq.1).and.tract_ob) then
        if (distance(1,0).lt.900.0.and.abs(speed).le.1) then
          score = score + 500
          b_message(2) = s_message(11)
          call strek_message (b_message, 3)
          tract_ob = .false.
          object(1) = .false.
          dock_n = dock_n + 1
        end if
      end if
c
c    check for photon proximity explosions
c      
      do 20 j = 4,9
        if (object(j)) then
          photon_c(j-3) = photon_c(j-3) + 1
          if (photon_c(j-3).gt.60) object(j) = .false.
          if (j.gt.6) then
            do 30 i = 1,3
              if (object(i).and.(distance(i,j).le.photon_tr(j).and.
     &            orange(j).gt.1600.0)) then
                object(j) = .false.
                call strek_photon_damage (distance(i,j), odamage(i),
     &                                    seed, type)
                a_message(1) = ph_message(index(i))
                write (a_message(3),'(a36,a10)') s_message(14),
     &                 dam_rating(type)
                call strek_message (a_message, 3)
              end if
 30         continue
          else
c
c    check for nemian hits
c
            if (object(1).and.(distance(1,j).lt.photon_tr(j))) then
              if (.not.object(2).or.distance(2,j).gt.900.0) then
                if (.not.object(3).or.distance(3,j).gt.900.0) then
                  object(j) = .false.
                  call strek_photon_damage (distance(1,j), odamage(1), 
     &                                      seed, type)              
                end if
              end if
            end if
c
c    check for player ship hits
c
            if (orange(j).lt.photon_tr(j)) then
              if (.not.object(2).or.distance(2,j).gt.225.0) then
                if (.not.object(3).or.distance(3,j).gt.225.0) then
                  object(j) = .false.
                  call strek_photon_damage (orange(j), damage, 
     &                                      seed, type)
                  write (ap_message(3),'(a42,a10)') s_message(15),
     &                   dam_rating(type)
                  call strek_message (ap_message, 3)
                end if
              end if
            end if
          end if
        end if
 20   continue
c
c    if enemy ships are alive then move 'em
c
      if (object(2).or.object(3)) then
        do 50 j = 2,3
          if (object(j)) then
            call strek_move_enemy (j, obx, oby, obz, oazm, oangle,
     &                             ospeed, xc, yc, zc, azm, angle,
     &                             speed, agr(j), object, rox(j),
     &                             roy(j), roz(j), odamage, pc(j),
     &                             distance, kling(j), cm(j), cs(j),
     &                             orange, razm(j), rangle(j), 
     &                             brake(j), damage, photon_c,
     &                             phase_c, pro_x, pro_y, seed, center)
          end if
 50     continue
      else if (waited .gt. turns_wait) then
c
c    reset damage totals, pick ship type and aggression levels
c
        call strek_enemy_setup (odamage, agr, kling, maxd, object, seed,
     &                          two, pc) 
        j = 2
        k = 3
        if (two) then
          call strek_place_enemy (xc, yc, zc, obx(j), oby(j), obz(j),
     &                            oazm(j), oangle(j), ospeed(j), seed)
          call strek_place_enemy (xc, yc, zc, obx(k), oby(k), obz(k),
     &                            oazm(k), oangle(k), ospeed(k), seed)
        else
          call strek_place_enemy (xc, yc, zc, obx(j), oby(j), obz(j),
     &                            oazm(j), oangle(j), ospeed(j), seed)
        end if
        waited = 0
      else if (waited .eq. 0) then
        call rand (seed)
        turns_wait = seed * 150.0 + 50
        waited = 1
      else
        waited = waited + 1
      end if  
c
c    evaluate sum of damages (both photon and phaser) to other objects
c
      do 40 j= 1,9
        if (object(j).and.(odamage(j).ge.maxd(j))) then
          if (j.eq.1) then
            ship_n = ship_n + 1
          else if (kling(j)) then
            ship_k = ship_k + 1
          else
            ship_r = ship_r + 1
          end if
          object(j) = .false.
          k_message(1) = d_message(index(j))
          if (j.eq.2.or.j.eq.3) then
            write (k_message(2),'(a27,f10.2)') s_message(12), value(j)
            write (k_message(3),'(a11,a10)') s_message(13), nick_name
          else if (j.eq.1) then
            write (k_message(2),'(a13,f10.2)') s_message(16), value(j)
            write (k_message(3),'(a36,a10)') s_message(17), capt_name 
            call rand (seed)
            if (seed.gt.0.5) then
              agr(2) = .false.
            end if
            call rand (seed)
            if (seed.gt.0.5) then
              agr(3) = .false.
            end if
          else
            k_message(2) = k_message(1)
            k_message(1) = ' '
            k_message(3) = ' '
          end if
          call strek_message (k_message, 3)
          score = score + value(j)
        end if
 40   continue
c
c    process lock on coordinates
c
      nav_c = nav_c + 1
      if (lock_on) then
        if (orange(l_object).gt.10000.0.and.nav_c.ge.10) then
          nav_c = 0
          if (speed.lt.0.0) then
            s1 = -speed
            s2 = azm + 180.0
            if (s2.gt.360.0) s2 = s2 - 360.0
            s3 = 360.0 - angle
            reverse = .true.
          else
            s1 = speed
            s2 = azm
            s3 = angle
            reverse = .false.
          end if
          if (s1.gt.1.e-2) then
            num_forward = sqrt(orange(l_object)) / s1
          else
            num_forward = 20
          end if
          j = l_object
          xt1 = -num_forward * ospeed(j) * sin(oazm(j)) * 
     &           cos(oangle(j)) + obx(j)
          yt1 =  num_forward * ospeed(j) * cos(oazm(j)) *
     &           cos(oangle(j)) + oby(j)
          zt1 =  num_forward * ospeed(j) * sin(oangle(j))
     &           + obz(j)
          dx = xt1 - xc
          dy = yt1 - yc
          dz = zt1 - zc
          if (abs(dy).lt.1.0) dy = sign (1.0, dy)
          if (dy.le.0.0) then
            tazm = -de(atan(dx/dy)) + 180.0
          else
            tazm = -de(atan(dx/dy))
          end if
          if (tazm.lt.0.0) tazm = tazm + 360.0
          dist = sqrt(dx**2 + dy**2)
          if (dist.lt.1.0) dist = 1.0
          tangle = de(atan(dz/dist))
c
c    pick smallest angle (needed due to arctan being only in
c    I and IV quadrants
c
          t1 = (tazm - s2)/10.0
          t2 = (tangle - s3)/10.0
          t3 = (tazm - (s2 + 360.0))/10.0
          t4 = (tangle - (s3 + 360.0))/10.0
          t5 = (tazm - (s2 - 360.0))/10.0
          t6 = (tangle - (s3 - 360.0))/10.0
          if (abs(t3).lt.abs(t1)) t1 = t3
          if (abs(t5).lt.abs(t1)) t1 = t5
          if (abs(t4).lt.abs(t2)) t2 = t4
          if (abs(t6).lt.abs(t2)) t2 = t6
          if (reverse) t2 = - t2
c
c    limit rotation angles by max ship ability
c
          if (abs(t1).gt.0.6) t1 = sign(0.6, t1)
          if (abs(t2).gt.0.6) t2 = sign(0.6, t2)
c
c    set rotation vars
c
          rot_azm(10) = t1
          rot_ang(10) = t2
        end if
      end if
c
c    if rotate then rotate
c
      if (rot_azm(r_index).ne.0.0) then
        azm = azm + rot_azm(r_index)
        sa = sin(ra(azm))
        ca = cos(ra(azm))
      end if
      if (rot_ang(r_index).ne.0.0) then
        angle = angle + rot_ang(r_index)
        sp = sin(ra(angle))
        cp = cos(ra(angle))
      end if
      if ((.not.rotate).and.(.not.lock_on)) r_index = 9
c
c    rotate tractored object back to translated galatic coords centered
c    on ship
c
      if (tract_ob.and.tract) then
        if (.not.object(tr_object)) then
          tract_ob     = .false.
          b_message(2) = s_message(index(tr_object))
          call strek_message (b_message, 3)
        else
          trazm = trazm + ra(rot_azm(r_index))
          t1 = cos(trazm - ra(azm))
          trangle = trangle + ra(rot_ang(r_index)) * t1
          j = tr_object
          trx = rox(j)*ca - roy(j)*sa*cp + roz(j)*sa*sp + xc
          try = rox(j)*sa + roy(j)*ca*cp - roz(j)*ca*sp + yc
          trz =             roy(j)*sp    + roz(j)*cp    + zc
        end if
      end if
c
c    check that scan object still exists
c
      if (.not.(object(scan_ob)).and.(scan_ob.ge.4)) then
        scan_ob = 1
        b_message (2) = s_message(10)
        call strek_message (b_message, 3)
      end if
c
c    check that nav lock on object still exists
c
      if (lock_on.and.((.not.object(l_object).or.orange(l_object).lt.
     &    10000.0).or.(.not.scan))) then
        lock_on = .false.
        b_message(2) = 'Navigation lock on lost.'
        call strek_message (b_message, 3)
        r_index = 9
      end if
c
c    apply damage to the player's ship
c
      call strek_assess_damage (d_pct, damage, scan, tract, phase,
     &                          energy, seed)
c
c    get a key if one has been struck
c
      unobscured = gprcondeventwait (event_type, key, c_pos, status)
      if (event_type.ne.gprnoevent) then
        call strek_interpret_key (key)
c
c    process a speed key
c
        if (key.eq.'a') then
          speed = speed + 0.5
          if (speed.gt.5.0) then
            speed = 5.0
            b_message(2) = s_message(9)
            call strek_message (b_message, 3)
          end if
        else if (key.eq.'s') then
          speed = speed - 0.5
          if (speed.lt.-5.0) then
            speed = -5.0
            b_message(2) = s_message(9)
            call strek_message (b_message, 3)
          end if
        end if
c
c    process a rotate key
c
        if (.not.lock_on) then
          if (key.eq.'m') then
            r_index = 9
          else if (key.eq.'b') then
            rotate = .not.rotate
          else
            if (.not.rotate) then
              if (key.eq.'u') then
                r_index = 1
              else if (key.eq.'j') then
                r_index = 2
              else if (key.eq.'h') then
                r_index = 3
              else if (key.eq.'n') then
                r_index = 4
              end if
            else
              if (key.eq.'u') then
                r_index = 5
              else if (key.eq.'j') then
                r_index = 6
              else if (key.eq.'h') then
                r_index = 7
              else if (key.eq.'n') then
                r_index = 8
              end if       
            end if
          end if
        end if
c
c    process a tractor beam key
c
        if ((key.eq.'t'.and.tract).and.(.not.tract_ob)) then
          call strek_number_objects (pos_store, ran_store, object,
     &                               .true.)
          call strek_message (t_message, 3)
          i = 0
 60       continue
            i = i + 1
            unobscured = gprcondeventwait (event_type, t_key, c_pos,
     &                                         status)
            if (event_type.ne.gprnoevent.or.i.gt.3000) goto 70
            goto 60
 70       continue
          call strek_number_objects (pos_store, ran_store, object,
     &                               .false.)
          if (event_type.ne.gprnoevent) then
            call strek_interpret_key (t_key)
            if ((t_key.eq.'1').or.((t_key.ge.'4').and.(t_key.le.'9')))
     &        then
              read (t_key,'(i1)') tr_object
              if (object(tr_object).and.orange(tr_object).lt.9.0e4) then
                tract_ob = .true.
                j        = tr_object
                trx      = obx(j)
                try      = oby(j)
                trz      = obz(j)
                trazm    = oazm(j)
                trangle  = oangle(j)
                trdist   = orange(j)
                b_message(2) = u_message(index(j))
                call strek_message (b_message, 3)
              end if
            end if
          end if
        end if
c
c    process a drop tractor key
c
        if (key.eq.'r'.and.tract_ob) then
          tract_ob          = .false.
          oazm(tr_object)   = trazm
          oangle(tr_object) = trangle
          b_message(2)      = s_message(7)
          call strek_message (b_message, 3)
        end if 
c
c    process an damage information key
c
        if (key.eq.'i') then
          call strek_damage_info (d_pct, capt_name, nick_name)
        end if
c
c    process a photon key
c
        if (key.eq.'f'.and.(photons.ge.1)) then          
          call strek_find_free_ob (object, 7, j, found)
          if (found) then
            object(j)     = .true.
            photon_c(j-3) = 0
            photons       = photons - 1
            obx(j)        = xc
            oby(j)        = yc
            obz(j)        = zc
            oazm(j)       = ra(azm)
            oangle(j)     = ra(angle)
            ospeed(j)     = 10
            b_message(2)  = s_message(8)
            call strek_message (b_message, 3)
          end if
        end if
c
c    process a phaser key
c
        if (((key.eq.'p').and.(phase)).and.(energy.gt.30.0)) then
          call strek_number_objects (pos_store, ran_store, object, 
     &                              .true.)
          call strek_message (p_message, 3)
          i = 0
 80       continue
            i = i + 1
            unobscured = gprcondeventwait (event_type, t_key, c_pos,
     &                                         status)
            if (event_type.ne.gprnoevent.or.i.gt.3000) goto 90
            goto 80
 90       continue
          call strek_number_objects (pos_store, ran_store, object,
     &                               .false.)
          if (event_type.ne.gprnoevent) then
            call strek_interpret_key (t_key)
            if ((t_key.ge.'0').and.(t_key.le.'9')) then
              read (t_key,'(i1)') ph_object                   
              if (object(ph_object).and.(orange(ph_object).lt.250000.0))
     &           then
                if ((pro_x(ph_object).le.800.and.pro_x(ph_object).ge.
     &            100).and.(pro_y(ph_object).le.700.and.
     &            pro_y(ph_object).ge.100)) then
                  call strek_draw_phasers (int(pro_x(ph_object)),
     &                                     int(pro_y(ph_object)))
                  energy = energy - 30.0
                  phase_d = .true.
                  phase_c = 0
                  phase = .false.
c
c    do damage to other ship
c
                  call strek_phaser_fire (orange(ph_object), seed,
     &                                    odamage(ph_object), type)
                  a_message(1) = ps_message(index(ph_object))
                  write (a_message(3),'(a36,a10)') s_message(14),
     &                   dam_rating(type)
                  call strek_message (a_message, 3)
                end if
              end if
            end if
          end if
        end if
c
c    process a explode radius key
c
        if (key.eq.'e') then
          call strek_message (e_message, 3)
          i = 0
100       continue
            i = i + 1
            unobscured = gprcondeventwait (event_type, t_key, c_pos,
     &                                         status)
            if (event_type.ne.gprnoevent.or.i.gt.5000) goto 110
            goto 100
110       continue
          if (event_type.ne.gprnoevent) then
            call strek_interpret_key (t_key)
            if ((t_key.gt.'0').and.(t_key.le.'6')) then
              read (t_key,'(i1)') option
              t1 = 10.0 + 5.0*option
              photon_tr(7) = t1**2
              photon_tr(8) = photon_tr(7)
              photon_tr(9) = photon_tr(7)
            end if
          end if
        end if
c
c    change scanner object keys
c
        if (key.ge.'0'.and.key.le.'9') then
          read (key,'(i1)') item
          if (object(item)) then
            scan_ob = item
            b_message(2) = sc_message(index(item))
            call strek_message (b_message, 3)
          end if
        end if
c
c    process a nav lock on key
c
      if (key.eq.'l'.and.scan) then
        call strek_message (t_message, 3)
        i = 0
120     continue
          i = i + 1
          unobscured = gprcondeventwait (event_type, t_key, c_pos,
     &                                       status)
          if (event_type.ne.gprnoevent.or.i.gt.5000) goto 130
          goto 120
130     continue
        if (event_type.ne.gprnoevent) then
          call strek_interpret_key (t_key)
          if (t_key.ge.'0'.and.t_key.le.'3') then
            read (t_key,'(i1)') l_object
            if (object(l_object).and.orange(l_object).gt.22500.0) then
              lock_on = .true.
              b_message(2) = l_message(index(l_object))
              call strek_message (b_message, 3)
              r_index = 10
              nav_c = 10
            end if
          end if
        end if
      end if
c
c    process a nav lock drop key
c
      if (key.eq.'o'.and.lock_on) then
        lock_on = .false.       
        b_message(2) = 'Navigation lock on dropped.'
        call strek_message (b_message, 3)
        r_index = 9
      end if
c
c    process a dock key
c
        if ((key.eq.'d'.and.orange(0).lt.900.0).and.(abs(speed).lt.1))
     &      then
          call strek_dock (d_pct, score, user_name,
     &                     capt_name, nick_name,
     &                     ship_name, cum_score, key_file, new_ship)
          stop
        end if
c
c    process a current score key
c
        if (key.eq.'c') then
          write (r_message(1),'(a15,a30)') r_message(1), ship_name
          write (r_message(3),'(i8,i10,i9,i16,2i7)') ship_k, ship_r,
     &           ship_n, dock_n, score, cum_score
          call strek_message (r_message, 3)
        end if
c
c    process a clear com window key
c
        if (key.eq.'z') then
          b_message(2) = ' '
          call strek_message (b_message, 3)
        end if
c
c    process a sleep until key
c
        if (key.eq.'/') then
          call strek_message (sl_message, 3)
125       continue
            unobscured = gprcondeventwait (event_type, t_key, c_pos,
     &                                         status)
            if (event_type.ne.gprnoevent) goto 135
            goto 125
135       continue
          b_message(2) = ' '
          call strek_message (b_message, 3)
        end if
c
c    end parsing routines
c
      end if
c
c    put angles back to normal (between 0 and 360)
c
      if (azm.lt.0.0)       azm = azm   + 360.0
      if (azm.ge.360.0)     azm = azm   - 360.0
      if (angle.lt.0.0)   angle = angle + 360.0
      if (angle.ge.360.0) angle = angle - 360.0
c
c     add engine energy output
c
       energy = energy + .35 * (d_pct(1) + d_pct(2))
c
c     subtract off energy due to speed and rotation
c
       energy = energy - abs(speed)/7.5 - rot_cost(r_index)
c
c     subtract energy due to tractors
c
       if (tract_ob) then
         energy = energy - sqrt(trdist)/60.0*tr_cost(tr_object) +0.1
       end if
c
c     limit energy by battery percent
c
       check = d_pct(4)*1000.0
       if (energy.gt.check) energy = check
c
c     if out of energy start (or continue) death march
c
       if (energy.lt.0.0) then
         num_times = num_times + 1
         call strek_no_energy (num_times, user_name,
     &                         capt_name, nick_name,
     &                         ship_name, key_file, score, cum_score,
     &                         new_ship)
       else
         num_times = 0
       end if
c
c    process new coordinates
c
      tempx = xc
      tempy = yc
      tempz = zc
      xc = -sa * cp * speed + xc
      yc =  ca * cp * speed + yc
      zc =  sp * speed      + zc
      do 150 j = 0,9
        if (object(j)) then
          if (j .ne. 0) then
            soa(j) = sin(oazm(j))
            coa(j) = cos(oazm(j))
            sop(j) = sin(oangle(j))
            cop(j) = cos(oangle(j))
            obx(j) = -soa(j) * cop(j) * ospeed(j) + obx(j)
            oby(j) =  coa(j) * cop(j) * ospeed(j) + oby(j)
            obz(j) =  sop(j) * ospeed(j)          + obz(j)
          end if
          xt(j)  = obx(j) - xc
          yt(j)  = oby(j) - yc
          zt(j)  = obz(j) - zc
          orange(j) = xt(j)**2 + yt(j)**2 + zt(j)**2
        end if
150   continue
c
c    update tractored object
c      
      if (tract_ob.and.tract) then                     
        trx = trx - tempx + xc
        try = try - tempy + yc
        trz = trz - tempz + zc
        j = tr_object
        obx(j) = trx
        oby(j) = try
        obz(j) = trz
        oazm(j) = trazm
        oangle(j) = trangle
        xt(j) = obx(j) - xc
        yt(j) = oby(j) - yc
        zt(j) = obz(j) - zc
        orange(j) = xt(j)**2 + yt(j)**2 + zt(j)**2
        trdist = orange(j)
      end if
c
c    get object to object distances when both exist
c
      do 160 j = 0,9
        if (object(j)) then
          do 170 i = 1,3
            if (object(i).and.i.ne.j) then
              distance(i,j) = (obx(i) - obx(j))**2 + (oby(i) -
     &                            oby(j))**2 + (obz(i) - obz(j))**2
            end if
170       continue
        end if
160   continue
c
c    rotate objects into shipocentric coordinates
c
      do 180 j = 0,9
        if (object(j)) then
          rox(j) =  xt(j) * ca      + yt(j) * sa
          roy(j) = -xt(j) * sa * cp + yt(j) * ca * cp + zt(j) * sp
          roz(j) =  xt(j) * sa * sp - yt(j) * ca * sp + zt(j) * cp
c
c    project shiopcentric coordinates to screen coords
c
          if (roy(j).gt.1.0) then          
            pro_x(j) = 450.0 + (rox(j)/roy(j)) * 350.0
            pro_y(j) = 400.0 - (roz(j)/roy(j)) * 350.0
            if (abs(pro_x(j)).gt.3000.0) pro_x(j) = 1000.0
            if (abs(pro_y(j)).gt.3000.0) pro_y(j) = 1000.0
          else
            pro_x(j) = 1000.0
            pro_y(j) = 1000.0
            if (j .eq. 2) then
              center(1) = 1000
              center(2) = 1000
            end if
          end if
c
c    fill temporary array for use in scanner windows
c
          pos_store(j,1) = pro_x(j)
          pos_store(j,2) = pro_y(j)
        end if
180   continue
c
c     erase old objects
c
      call gprsetdrawvalue (0, status)
      if (refresh) then
        call strek_scanner (rox, roy, roz, object, .false.)
      end if
      if (plot(0)) then
        call strek_starbase (xc, yc, zc, ca, cp, sa, sp, .false.) 
      end if
      do 190 j = 1, 9
        if (plot(j)) then
          goto (191, 192, 193, 194, 195, 196, 197, 198, 199) j
191       continue
            call strek_nemian (xc, yc, zc, obx(j), oby(j), obz(j), ca, 
     &                         sa, cp, sp, .false., soa(j), coa(j),
     &                         sop(j), cop(j))
            goto 190
192       continue
            if (kling(j)) then
              call strek_klingon (xc, yc, zc, obx(j), oby(j), obz(j),
     &                            ca, sa, cp, sp, .false., center,
     &                            soa(j), coa(j), sop(j), cop(j))
            else
              call strek_romulan_1 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .false., soa(j),
     &                              coa(j), sop(j), cop(j))
            end if
          goto 190
193       continue
            call strek_romulan_2 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                            ca, sa, cp, sp, .false., soa(j),
     &                            coa(j), sop(j), cop(j))
            goto 190
194       continue
            call strek_photon_1 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
195       continue         
            call strek_photon_2 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
196       continue
            call strek_photon_3 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
197       continue
            call strek_photon_4 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
198       continue
            call strek_photon_5 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
199       continue
            call strek_photon_6 (xc, yc, zc, obx(j), oby(j), obz(j), ca,
     &                           sa, cp, sp, .false.)
            goto 190
        end if
190   continue
c
c    update screen objects
c
      call gprsetdrawvalue (1, status)
      if (refresh) then
        call strek_scanner (rox, roy, roz, object, .true.)
      end if
      refresh = .not. refresh
      do 200 j = 0,9
        plot(j) = .false.
        ran_store(j) = orange(j)
        if (object(j).and.orange(j).lt.4000000.0) then
          if ((pro_x(j).lt.900.0).and.(pro_x(j).gt.0.0)) then
            if ((pro_y(j).lt.800.0).and.(pro_y(j).gt.0.0)) then
              plot(j) = .true.
              if (j.eq.0) then
                call strek_starbase (xc, yc, zc, ca, cp, sa, sp,
     &                               .true.) 
              else 
                goto (201, 202, 203, 204, 205, 206, 207, 208, 209) j
201             continue
                call strek_nemian (xc, yc, zc, obx(j), oby(j), obz(j),
     &                             ca, sa, cp, sp, .true., soa(j),
     &                             coa(j), sop(j), cop(j))
                goto 200
202             continue 
                if (kling(j)) then
                  call strek_klingon (xc, yc, zc, obx(j), oby(j),
     &                                obz(j), ca, sa, cp, sp, .true.,
     &                                center, soa(j), coa(j), sop(j),
     &                                cop(j))
                else
                  call strek_romulan_1 (xc, yc, zc, obx(j), oby(j),
     &                                  obz(j), ca, sa, cp, sp, .true.,
     &                                  soa(j), coa(j), sop(j), cop(j))
                end if
                goto 200
203            continue
               call strek_romulan_2 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                               ca, sa, cp, sp, .true., soa(j),
     &                               coa(j), sop(j), cop(j))
                goto 200
204           continue
               call strek_photon_1 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
               goto 200
205           continue
               call strek_photon_2 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
               goto 200
206           continue
               call strek_photon_3 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
                goto 200
207           continue
               call strek_photon_4 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
                goto 200
208           continue
               call strek_photon_5 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
                goto 200
209           continue
               call strek_photon_6 (xc, yc, zc, obx(j), oby(j), obz(j),
     &                              ca, sa, cp, sp, .true.)
                goto 200
              end if
            end if
          end if
        end if
200   continue
c
c    draw center of the screen crosshairs
c
      call strek_x_hairs
c
c    update panels
c
      if (scan) then
        txc = nint(rox(scan_ob))
        tyc = nint(roy(scan_ob))
        tzc = nint(roz(scan_ob))
        trange = nint(sqrt(orange(scan_ob)))
      end if
      rate = speed * 2
      call strek_update_panel (rate, int(energy), photons, phase, 
     &                         tract_ob, int(xc), int(yc), int(zc),
     &                         scan, txc, tyc, tzc, trange, scan_ob)
      call strek_flashers (object, lock_on, energy, bitmap_desc)
c
c    evaluate the turn duration, if it is shorter than the
c    minimum (which is .06 seconds) then request it again.
c    Since this call is slow it makes an ideal timer.
c
210   continue
      call timeclock (timer)
      call calfloatclock (timer, turn)
      duration = turn - elapsed
      if (duration.gt.0.06) then
        elapsed = turn
c        goto 10
      end if
      timer(1) = 0
      timer(2) = 0
      timer(3) = 15000
      call timewait (timerelative, timer, status)
      goto 10
c      goto 210
      end