      subroutine strek_nemian (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                         ssp, dir, sa, ca, sp, cp)
c
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    STREK_NEMIAN draws a nemian freighter in 3-d at xs, ys, zs as
c    seen from xc, yc, zc.
c
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(10), y_pt(10), x_pt1(6), y_pt1(6), center(2)
      integer*2 radius
      real*4 x1(10), y1(10), z1(10), x2(7), y2(7), z2(7)
      real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10)
      real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10)
      logical dir
c
c    saves and data for ship config
c
      save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1
      save radius
      data x1 /2.5, 2.5, 2.5, -2.5, -2.5, -2.5, -2.5, 2.5, 2.5, -2.5/
      data y1 /-5, -7.5, 3.5, 3.5, -7.5, -5, 2.5, 2.5, -5, -5/
      data z1 /-2.5, 2.5, 2.5, 2.5, 2.5, -2.5, -2.5, -2.5, -2.5, -2.5/
      data x2 /-2.5, 2.5, -2.5, -2.5, 2.5, 2.5, 0/
      data y2 /-7.5, -7.5, 3.5, 2.5, 3.5, 2.5, 5/
      data z2 /2.5, 2.5, 2.5, -2.5, 2.5, -2.5, 0/
      data pi /3.14159265/
c
c    if dir then rotate ship into galatic coordinates
c
      if (dir) then
c
c    rotate the points about the local position
c
        do 10 j = 1,10
          t1(j) =  x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs
          t2(j) =  x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys
          t3(j) =               y1(j) * sp +      z1(j) * cp      + zs
 10     continue
        do 20 j = 1,7
          t4(j) =  x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs
          t5(j) =  x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys
          t6(j) =               y2(j) * sp +      z2(j) * cp      + zs
 20     continue
c
c    form offsets from player ship and rotate them about it
c
        do 30 j = 1,10
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          r1(j) =  t1(j) * csa + t2(j) * ssa                     
          r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          r3(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (r2(j).lt.1) r2(j) = 1.0
          x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0
          y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0
 30     continue
        do 40 j = 1,7
          t4(j) = t4(j) - xc
          t5(j) = t5(j) - yc
          t6(j) = t6(j) - zc
          r4(j) =  t4(j) * csa + t5(j) * ssa                     
          r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp
          r6(j) =  t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp 
          if (r5(j).lt.1) r5(j) = 1.0
          if (j.ne.7) then
            x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0
            y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0
          else
            center(1) = 450.0 + (r4(j)/r5(j)) * 350.0
            center(2) = 400.0 - (r6(j)/r5(j)) * 350.0
          end if
 40     continue
        radius = (2.50/r5(7) * 350.0 + .5)
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(10), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(6), istat)
        if (radius.gt.0) then
          call gpr_$circle (center, radius, istat)
        end if
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(10), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(6), istat)
        if (radius.gt.0) then
          call gpr_$circle (center, radius, istat)
        end if
      end if      
      return
      end



      subroutine strek_klingon (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                          ssp, dir, pcen, sa, ca, sp, cp)
c
c    STREK_KLINGON_1 draws a klingon in 3-d at xs, ys, zs as
c    seen from xc, yc, zc.
c
c    version 1
c                                            -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(15), y_pt(15), x2_pt(9), y2_pt(9), x3_pt(5)
      integer*2 y3_pt(5), x4_pt(5), y4_pt(5), x5_pt(12), y5_pt(12)
      integer*2 center(2), radius, pcen(2)
      real*4 x1(15), y1(15), z1(15), x2(9), y2(9), z2(9), x3(5), y3(5)
      real*4 z3(5), x4(5), y4(5), z4(5), x5(13), y5(13), z5(13)
      real*4 t1(15), t2(15), t3(15), t4(15), t5(15), t6(15), t7(15)
      real*4 t8(15), t9(15), t10(15), t11(15), t12(15), t13(15)
      real*4 t14(15), t15(15)
      real*4 r1(15), r2(15), r3(15), r4(15), r5(15), r6(15), r7(15)
      real*4 r8(15), r9(15), r10(15), r11(15), r12(15), r13(15)
      real*4 r14(15), r15(15)
      logical dir
c
c    saves and data for ship config
c
      save x1, x2, x3, x4, x5, y1, y2, y3, y4, y5, z1, z2, z3, z4, z5
      save x_pt, y_pt, x2_pt, y2_pt, x3_pt, y3_pt, x4_pt, y4_pt, center
      save radius, x5_pt, y5_pt
      data x1 /.75, 1.0, 6.5, 7.5, 7.5, 6.5, 6.5, 0.0, -6.5, -6.5, -7.5,
     &         -7.5, -6.5, -1.0, -.75/
      data y1 /6.0, 3.0, 0.0, 0.0, -7.5, -7.5, -1.5, -3.5, -1.5, -7.5, 
     &         -7.5, 0.0, 0.0, 3.0, 6.0/
      data z1 /1.0, 0.8, 0.1, 0.1, 0.1, 0.1, 0.1, 1.0, 0.1, 0.1, 0.1,
     &         0.1, 0.1, 0.8, 1.0/
      data x2 /0.75, 1.0, 6.5, 6.5, 0.0, -6.5, -6.5, -1.0, -0.75/
      data y2 /6.0, 3.0, 0.0, -1.5, -3.5, -1.5, 0.0, 3.0, 6.0/
      data z2 /-1.0, -0.8, -0.1, -0.1, -1.0, -0.1, -0.1, -0.8, -1.0/
      data x3 /6.5, 6.5, 7.5, 7.5, 6.5/
      data y3 /0.0, -7.5, -7.5, 0.0, 0.0/
      data z3 /-2.0, -2.0, -2.0, -2.0, -2.0/
      data x4 /-6.5, -6.5, -7.5, -7.5, -6.5/
      data y4 /0.0, -7.5, -7.5, 0.0, 0.0/
      data z4 /-2.0, -2.0, -2.0, -2.0, -2.0/
      data x5 /7.5, 7.5, 7.5, 7.5, 6.5, 6.5, -7.5, -7.5, -7.5, -7.5,
     &         -6.5, -6.5, 0.0/                                             
      data y5 /0.0, 0.0, -7.5, -7.5, -7.5, -7.5, 0.0, 0.0, -7.5, -7.5,
     &         -7.5, -7.5, 7.5/
      data z5 /0.1, -2.0, 0.1, -2.0, 0.1, -2.0, 0.1, -2.0, 0.1, -2.0, 
     &         0.1, -2.0, 1.0/
c
c    if dir then rotate into galatic coords
c
      if (dir) then
c
c    rotate the points about the local position
c
        do 10 j = 1,15
          t1(j) =  x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs
          t2(j) =  x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys
          t3(j) =               y1(j) * sp +      z1(j) * cp      + zs
 10     continue
        do 20 j = 1,5
          t7(j) =  x3(j) * ca - y3(j) * sa * cp + z3(j) * sa * sp + xs
          t8(j) =  x3(j) * sa + y3(j) * ca * cp - z3(j) * ca * sp + ys
          t9(j) =               y3(j) * sp +      z3(j) * cp      + zs
          t10(j) = x4(j) * ca - y4(j) * sa * cp + z4(j) * sa * sp + xs
          t11(j) = x4(j) * sa + y4(j) * ca * cp - z4(j) * ca * sp + ys
          t12(j) =              y4(j) * sp +      z4(j) * cp      + zs
 20     continue
        do 30 j = 1,13
          t13(j) = x5(j) * ca - y5(j) * sa * cp + z5(j) * sa * sp + xs
          t14(j) = x5(j) * sa + y5(j) * ca * cp - z5(j) * ca * sp + ys
          t15(j) =              y5(j) * sp +      z5(j) * cp      + zs
 30     continue 
c
c    form offsets from player ship and rotate them about it
c
        do 40 j = 1,15
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          r1(j) =  t1(j) * csa + t2(j) * ssa                     
          r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          r3(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (r2(j).lt.1) r2(j) = 1.0
          x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0
          y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0
 40     continue
        do 50 j = 1,5
          t7(j) = t7(j) - xc
          t8(j) = t8(j) - yc
          t9(j) = t9(j) - zc
          r7(j) =  t7(j) * csa + t8(j) * ssa                     
          r8(j) = -t7(j) * ssa * csp + t8(j) * csa * csp + t9(j) * ssp
          r9(j) =  t7(j) * ssa * ssp - t8(j) * csa * ssp + t9(j) * csp 
          if (r8(j).lt.1) r8(j) = 1.0
          x3_pt(j) = 450.0 + (r7(j)/r8(j)) * 350.0
          y3_pt(j) = 400.0 - (r9(j)/r8(j)) * 350.0
          t10(j) = t10(j) - xc
          t11(j) = t11(j) - yc
          t12(j) = t12(j) - zc
          r10(j) =  t10(j) * csa + t11(j) * ssa                     
          r11(j) = -t10(j) * ssa * csp + t11(j) * csa * csp + t12(j)
     &              * ssp
          r12(j) =  t10(j) * ssa * ssp - t11(j) * csa * ssp + t12(j)
     &              * csp 
          if (r11(j).lt.1) r11(j) = 1.0
          x4_pt(j) = 450.0 + (r10(j)/r11(j)) * 350.0
          y4_pt(j) = 400.0 - (r12(j)/r11(j)) * 350.0
 50     continue
        do 60 j = 1,13
          t13(j) = t13(j) - xc
          t14(j) = t14(j) - yc
          t15(j) = t15(j) - zc
          r13(j) =  t13(j) * csa + t14(j) * ssa                     
          r14(j) = -t13(j) * ssa * csp + t14(j) * csa * csp + t15(j) 
     &              * ssp
          r15(j) =  t13(j) * ssa * ssp - t14(j) * csa * ssp + t15(j)
     &              * csp 
          if (r14(j).lt.1) r14(j) = 1.0
          if (j.eq.13) then
            center(1) = 450.0 + (r13(j)/r14(j)) * 350.0
            center(2) = 400.0 - (r15(j)/r14(j)) * 350.0
            pcen(1) = center(1)
            pcen(2) = center(2)
          else
            x5_pt(j) = 450.0 + (r13(j)/r14(j)) * 350.0
            y5_pt(j) = 400.0 - (r15(j)/r14(j)) * 350.0
          end if
 60     continue
        radius = (1.5 / r14(13) * 350.0 + .5)
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(15), istat)
        call gpr_$move (x3_pt(1), y3_pt(1),istat)
        call gpr_$polyline (x3_pt, y3_pt, int2(5), istat)
        call gpr_$move (x4_pt(1), y4_pt(1),istat)
        call gpr_$polyline (x4_pt, y4_pt, int2(5), istat)
        call gpr_$multiline (x5_pt, y5_pt, int2(12), istat)
        if (radius.gt.0) then
          call gpr_$circle (center, radius, istat)
        end if
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(15), istat)
        call gpr_$move (x3_pt(1), y3_pt(1),istat)
        call gpr_$polyline (x3_pt, y3_pt, int2(5), istat)
        call gpr_$move (x4_pt(1), y4_pt(1),istat)
        call gpr_$polyline (x4_pt, y4_pt, int2(5), istat)
        call gpr_$multiline (x5_pt, y5_pt, int2(12), istat)
        if (radius.gt.0) then
          call gpr_$circle (center, radius, istat)
        end if
      end if      
      return
      end




      subroutine strek_romulan_1 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                            ssp, dir, sa, ca, sp, cp)
c
c    STREK_ROMULAN_1 draws a romulan in 3-d at xs, ys, zs as
c    seen from xc, yc, zc.
c
c    version 1
c                                            -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(9), y_pt(9), x_pt1(8), y_pt1(8), center(2,2)
      integer*2 radius(2), xpt(2)
      real*4 x1(9), y1(9), z1(9), x2(10), y2(10), z2(10)
      real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10)
      real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10)
      logical dir
c
c    saves and data for ship config
c
      save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1
      save radius
      data x1 /6.5, 3.3, 0.0, -3.3, -6.5, 0.0, 6.5, 0.0, -6.5/
      data y1 /-3.5, 3.0, 5.0, 3.0, -3.5, -5.0, -3.5, -5.0, -3.5/
      data z1 /0.0, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, -1.5, 0.0/
      data x2 /0.0, 0.0, 3.3, 0.0, -3.3, 0.0, 0.0, 0.0, 7.5, -7.5/
      data y2 /5.0, -5.0, 3.0, 0.0, 3.0, 0.0, -5.0, 0.0, -3.5, -3.5/
      data z2 /0.0, 1.5, 0.0, -1.0, 0.0, -1.0, -1.5, -1.0, 0.0, 0.0/
c
c    if dir then rotate into galatic coords
c
      if (dir) then
c
c    rotate the points about the local position
c
        do 10 j = 1,9
          t1(j) =  x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs
          t2(j) =  x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys
          t3(j) =               y1(j) * sp +      z1(j) * cp      + zs
 10     continue
        do 20 j = 1,10
          t4(j) =  x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs
          t5(j) =  x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys
          t6(j) =               y2(j) * sp +      z2(j) * cp      + zs
 20    continue
c
c    form offsets from player ship and rotate them about it
c
        do 30 j = 1,9
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          r1(j) =  t1(j) * csa + t2(j) * ssa                     
          r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          r3(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (r2(j).lt.1) r2(j) = 1.0
          x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0
          y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0
 30     continue
        do 40 j = 1,10
          t4(j) = t4(j) - xc
          t5(j) = t5(j) - yc
          t6(j) = t6(j) - zc
          r4(j) =  t4(j) * csa + t5(j) * ssa                     
          r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp
          r6(j) =  t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp 
          if (r5(j).lt.1) r5(j) = 1.0
          if (j.le.8) then
            x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0
            y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0
          else
            i = j - 8
            center(i,1) = 450.0 + (r4(j)/r5(j)) * 350.0
            center(i,2) = 400.0 - (r6(j)/r5(j)) * 350.0
          end if
 40     continue
        radius(1) = (1.0/r5(9) *  350.0 + .5)
        radius(2) = (1.0/r5(10) * 350.0 + .5)
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(9), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(8), istat)
        do 50 j = 1,2
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 50     continue
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(9), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(8), istat)
        do 60 j = 1,2
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 60     continue
      end if      
      return
      end




      subroutine strek_romulan_2 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                            ssp, dir, sa, ca, sp ,cp)
c
c    STREK_ROMULAN_2 draws a romulan in 3-d at xs, ys, zs as
c    seen from xc, yc, zc.
c
c    version 1
c                                            -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(9), y_pt(9), x_pt1(8), y_pt1(8), center(2,2)
      integer*2 radius(2), xpt(2)
      real*4 x1(9), y1(9), z1(9), x2(10), y2(10), z2(10)
      real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10)
      real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10)
      logical dir
c
c    saves and data for ship config
c
      save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1
      save radius
      data x1 /6.5, 3.3, 0.0, -3.3, -6.5, 0.0, 6.5, 0.0, -6.5/
      data y1 /-3.5, 3.0, 5.0, 3.0, -3.5, -5.0, -3.5, -5.0, -3.5/
      data z1 /0.0, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, -1.5, 0.0/
      data x2 /0.0, 0.0, 3.3, 0.0, -3.3, 0.0, 0.0, 0.0, 7.5, -7.5/
      data y2 /5.0, -5.0, 3.0, 0.0, 3.0, 0.0, -5.0, 0.0, -3.5, -3.5/
      data z2 /0.0, 1.5, 0.0, -1.0, 0.0, -1.0, -1.5, -1.0, 0.0, 0.0/
c
c    if dir then rotate into galatic coords
c
      if (dir) then
c
c    rotate the points about the local position
c
        do 10 j = 1,9
          t1(j) =  x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs
          t2(j) =  x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys
          t3(j) =               y1(j) * sp +      z1(j) * cp      + zs
 10     continue
        do 20 j = 1,10
          t4(j) =  x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs
          t5(j) =  x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys
          t6(j) =               y2(j) * sp +      z2(j) * cp      + zs
 20    continue
c
c    form offsets from player ship and rotate them about it
c
        do 30 j = 1,9
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          r1(j) =  t1(j) * csa + t2(j) * ssa                     
          r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          r3(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (r2(j).lt.1) r2(j) = 1.0
          x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0
          y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0
 30     continue
        do 40 j = 1,10
          t4(j) = t4(j) - xc
          t5(j) = t5(j) - yc
          t6(j) = t6(j) - zc
          r4(j) =  t4(j) * csa + t5(j) * ssa                     
          r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp
          r6(j) =  t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp 
          if (r5(j).lt.1) r5(j) = 1.0
          if (j.le.8) then
            x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0
            y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0
          else
            i = j - 8
            center(i,1) = 450.0 + (r4(j)/r5(j)) * 350.0
            center(i,2) = 400.0 - (r6(j)/r5(j)) * 350.0
          end if
 40     continue
        radius(1) = (1.0/r5(9) *  350.0 + .5)
        radius(2) = (1.0/r5(10) * 350.0 + .5)
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(9), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(8), istat)
        do 50 j = 1,2
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 50     continue
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(9), istat)
        call gpr_$multiline (x_pt1, y_pt1, int2(8), istat)
        do 60 j = 1,2
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 60     continue
      end if      
      return
      end




      subroutine strek_photon_1 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_1 draws an enemy photon similar to a player photon
c    (see strek_photon_4).
c
c    version 1
c                                             -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(8), y_pt(8)
      integer*4 istat
      real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8)
      real*4 t6(8), pi, t5(8)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda,
     &     cdp, cda
      data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/
      data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/
      data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/
      data pi /3.14159265/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      ra(x) = x * pi / 180.0
      if (dir) then
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about the local position into galatic coords
c
        do 10 j = 1,8
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp      + zs
 10     continue
c
c    form offsets from player ship and rotate them about it
c
        do 20 j = 1,8
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa + t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (t5(j).lt.1.0) t5(j) = 1.0
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)        
      end if      
      return
      end





      subroutine strek_photon_2 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_2 draws an enemy photon similar to a player photon
c    (see strek_photon_4).
c
c    version 1
c                                             -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(8), y_pt(8)
      integer*4 istat
      real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8)
      real*4 t6(8), pi, t5(8)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda,
     &     cdp, cda
      data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/
      data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/
      data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/
      data pi /3.14159265/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      ra(x) = x * pi / 180.0
      if (dir) then
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about the local position into galatic coords
c
        do 10 j = 1,8
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp      + zs
 10     continue
c
c    form offsets from player ship and rotate them about it
c
        do 20 j = 1,8
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa + t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (t5(j).lt.1.0) t5(j) = 1.0
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)        
      end if      
      return
      end





      subroutine strek_photon_3 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_3 draws an enemy photon similar to a player photon
c    (see strek_photon_4).
c
c    version 1
c                                             -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(8), y_pt(8)
      integer*4 istat
      real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8)
      real*4 t6(8), pi, t5(8)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda,
     &     cdp, cda
      data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/
      data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/
      data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/
      data pi /3.14159265/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      ra(x) = x * pi / 180.0
      if (dir) then
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about the local position into galatic coords
c
        do 10 j = 1,8
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp      + zs
 10     continue
c
c    form offsets from player ship and rotate them about it
c
        do 20 j = 1,8
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa + t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (t5(j).lt.1.0) t5(j) = 1.0
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)
      else
c
c    erase old lines by drawing over them in black
c
        call gpr_$move (x_pt(1), y_pt(1),istat)
        call gpr_$polyline (x_pt, y_pt, int2(8), istat)        
      end if      
      return
      end





      subroutine strek_photon_4 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_4 draws a player photon torpedo (or erases depending
c    on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a
c    ship with angles csa, ssa, csp, and ssp. No provision is made
c    for views that are both in front of and behind the viewer, other
c    than to do a first order correction to the projected y coord.
c           
c    version 1
c                                                -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(14), y_pt(14)
      integer*4 istat
      real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14)
      real*4 t6(14), pi, t5(14)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp
      save ca, sa, cp, sp
      data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75,
     &         1.75, 1.75, -1.75/
      data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, 
     &         -1.75, 1.75, -1.75/
      data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5,
     &         2.5, -2.5/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      data pi /3.14159265/
      if (dir) then
c
c    use double angle formulas to update rotations
c
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about their local frame to bring them into the 
c    absolute frame
c
        do 10 j = 1,14
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp +      zs
 10     continue
c
c    form offsets from player ship and rotate them into its local frame
c
        do 20 j = 1,14
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa +       t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)
      else
c
c    erase old lines by drawing over them again (i.e. change color to
c    black, or set xor raster op)
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)        
      end if      
      return
      end






      subroutine strek_photon_5 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_5 draws a player photon torpedo (or erases depending
c    on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a
c    ship with angles csa, ssa, csp, and ssp. No provision is made
c    for views that are both in front of and behind the viewer, other
c    than to do a first order correction to the projected y coord.
c           
c    version 1
c                                                -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(14), y_pt(14)
      integer*4 istat
      real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14)
      real*4 t6(14), pi, t5(14)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp
      save ca, sa, cp, sp
      data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75,
     &         1.75, 1.75, -1.75/
      data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, 
     &         -1.75, 1.75, -1.75/
      data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5,
     &         2.5, -2.5/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      data pi /3.14159265/
      if (dir) then
c
c    use double angle formulas to update rotations
c
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about their local frame to bring them into the 
c    absolute frame
c
        do 10 j = 1,14
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp +      zs
 10     continue
c
c    form offsets from player ship and rotate them into its local frame
c
        do 20 j = 1,14
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa +       t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)
      else
c
c    erase old lines by drawing over them again (i.e. change color to
c    black, or set xor raster op)
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)        
      end if      
      return
      end





      subroutine strek_photon_6 (xc, yc, zc, xs, ys, zs, csa, ssa, csp,
     &                           ssp, dir)
c
c    STREK_PHOTON_6 draws a player photon torpedo (or erases depending
c    on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a
c    ship with angles csa, ssa, csp, and ssp. No provision is made
c    for views that are both in front of and behind the viewer, other
c    than to do a first order correction to the projected y coord.
c           
c    version 1
c                                                -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 x_pt(14), y_pt(14)
      integer*4 istat
      real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14)
      real*4 t6(14), pi, t5(14)
      logical dir
c
c    data for photon config and saves
c
      save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp
      save ca, sa, cp, sp
      data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75,
     &         1.75, 1.75, -1.75/
      data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, 
     &         -1.75, 1.75, -1.75/
      data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5,
     &         2.5, -2.5/
      data sda, sdp, cda, cdp /2*0.0998, 2*0.995/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
      data pi /3.14159265/
      if (dir) then
c
c    use double angle formulas to update rotations
c
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        temp = cp
        cp = cp * cdp - sp * sdp
        sp = sp * cdp + sdp * temp
c
c    rotate the points about their local frame to bring them into the 
c    absolute frame
c
        do 10 j = 1,14
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys
          t3(j) =               yp(j) * sp +      zp(j) * cp +      zs
 10     continue
c
c    form offsets from player ship and rotate them into its local frame
c
        do 20 j = 1,14
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa +       t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
          y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
 20     continue
c
c    draw the object
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)
      else
c
c    erase old lines by drawing over them again (i.e. change color to
c    black, or set xor raster op)
c
        call gpr_$multiline (x_pt, y_pt, int2(14), istat)        
      end if      
      return
      end




      subroutine strek_starbase (xc, yc, zc, csa, csp, ssa, ssp, dir)
c
c    STREK_STARBASE draws a 3-d starbase at the origin as viewed
c    from xc, yc, zc, at the angle csa, csp, ssa, ssp.
c
c    version 1
c                                          -jsr 8/85
c
% include '/sys/ins/base.ins.ftn'
% include '/sys/ins/gpr.ins.ftn'
c
      integer*2 center(5,2), x_pt(8), y_pt(8), xpt(2)
      integer*2 radius(5)
      integer*4 istat
      real*4 xp(13), yp(13), zp(13), radii(5), t1(13), t2(13), t3(13)
      real*4 t4(13), t5(13), t6(13)
      logical dir
c
c    data for unrotated base
c
      save xp, yp, zp, radii, pi, ca, sa, cp, sp, cda, cdp, sda, sdp
      save radius, center, x_pt, y_pt
      data xp /0.0, 0.0, 0.0, 0.0, -7.5, -12.0, 7.5, 12.0, 0.0, 0.0,
     &         0.0, -15.0, 15.0/
      data yp /0.0, 0.0, 8.66, 13.855, -4.33, -6.92, -4.33, -6.92, 0.0,
     &         0.0, 17.3, -8.66, -8.66/
      data zp /10.0, 16.0, -5.0, -8.0, -5.0, -8.0, -5.0, -8.0, 0.0,
     &         20.0, -10.0, -10.0, -10.0/
      data radii /10.0, 4.0, 4.0, 4.0, 4.0/
      data sda, sdp, cda, cdp /0.049979, 0.0, 0.998749, 0.0/
      data ca, cp, sa, sp /2*1.0, 2*0.0/
c
c    rotate and project all points
c
      if (dir) then
        temp = ca
        ca = ca * cda - sa * sda
        sa = sa * cda + sda * temp
        do 10 j = 1,13
          t1(j) =  xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp 
          t2(j) =  xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp 
          t3(j) =               yp(j) * sp +      zp(j) * cp     
 10     continue
c
c    form offsets from player ship and rotate them about it
c
        do 20 j = 1,13
          t1(j) = t1(j) - xc
          t2(j) = t2(j) - yc
          t3(j) = t3(j) - zc
          t4(j) =  t1(j) * csa + t2(j) * ssa                     
          t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp
          t6(j) =  t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp 
          if (t5(j).lt.5.0) t5(j) = 5.0
          if (j.le.8) then
            x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0
            y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0
          else
            i = j - 8
            center(i,1) = 450.0 + (t4(j)/t5(j)) * 350.0
            center(i,2) = 400.0 - (t6(j)/t5(j)) * 350.0  
            radius(i) = (radii(i) / t5(j) * 350.0 + .5)
          end if
 20     continue
        call gpr_$multiline (x_pt, y_pt, int2(8), istat)
        do 30 j = 1,5
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 30     continue
      else
c
c    erase old figure by redrawing in black or with xor raster op
c
        call gpr_$multiline (x_pt, y_pt, int2(8), i)
        do 40 j = 1,5
          xpt(1) = center(j,1)
          xpt(2) = center(j,2)
          if (radius(j).gt.0) then
            call gpr_$circle (xpt, radius(j), istat)
          end if
 40     continue
      end if
      return
      end


