pfuetz@agd.fhg.de (02/26/91)
Submitted-by: pfuetz@agd.fhg.de Posting-number: Volume 11, Issue 94 Archive-name: xstrek/part08 #!/bin/sh # To unshare, sh or unshar this file echo xstrek/original_code/strek_prune_db.f 1>&2 sed -e 's/^X//' > xstrek/original_code/strek_prune_db.f <<'E!O!F! xstrek/original_code/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, capt_name(k)*10, nick_name(k)*10 X character*256 key_file(k) Xc Xc get local date Xc X call cal_$decode_local_time (clock) Xc Xc open up file and read num_lines Xc X open (unit=1, file='strek_info', 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), 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), 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/original_code/strek_prune_db.f echo xstrek/original_code/strek_random_subs.f 1>&2 sed -e 's/^X//' > xstrek/original_code/strek_random_subs.f <<'E!O!F! xstrek/original_code/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 X 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 X X integer*4 k, j, m, ix, irand X real*4 x, rm X save k, j, m, rm X data k, j, m, rm / 5701, 3612, 566927, 566927.0/ X ix = int (x * rm) X irand = mod (j * ix + k, m) X x = (real (irand) + 0.5) / rm X return X end X X X E!O!F! xstrek/original_code/strek_random_subs.f echo xstrek/original_code/strek_ships_subs.f 1>&2 sed -e 's/^X//' > xstrek/original_code/strek_ships_subs.f <<'E!O!F! xstrek/original_code/strek_ships_subs.f' X subroutine strek_nemian (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir, sa, ca, sp, cp) Xc 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 STREK_NEMIAN draws a nemian freighter in 3-d at xs, ys, zs as Xc seen from xc, yc, zc. Xc Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(10), y_pt(10), x_pt1(6), y_pt1(6), center(2) X integer*2 radius X real*4 x1(10), y1(10), z1(10), x2(7), y2(7), z2(7) X real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10) X real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10) X logical dir Xc Xc saves and data for ship config Xc X save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1 X save radius X data x1 /2.5, 2.5, 2.5, -2.5, -2.5, -2.5, -2.5, 2.5, 2.5, -2.5/ X data y1 /-5, -7.5, 3.5, 3.5, -7.5, -5, 2.5, 2.5, -5, -5/ X data z1 /-2.5, 2.5, 2.5, 2.5, 2.5, -2.5, -2.5, -2.5, -2.5, -2.5/ X data x2 /-2.5, 2.5, -2.5, -2.5, 2.5, 2.5, 0/ X data y2 /-7.5, -7.5, 3.5, 2.5, 3.5, 2.5, 5/ X data z2 /2.5, 2.5, 2.5, -2.5, 2.5, -2.5, 0/ X data pi /3.14159265/ Xc Xc if dir then rotate ship into galatic coordinates Xc X if (dir) then Xc Xc rotate the points about the local position Xc X do 10 j = 1,10 X t1(j) = x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs X t2(j) = x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys X t3(j) = y1(j) * sp + z1(j) * cp + zs X 10 continue X do 20 j = 1,7 X t4(j) = x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs X t5(j) = x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys X t6(j) = y2(j) * sp + z2(j) * cp + zs X 20 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 30 j = 1,10 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X r1(j) = t1(j) * csa + t2(j) * ssa X r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X r3(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (r2(j).lt.1) r2(j) = 1.0 X x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0 X y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0 X 30 continue X do 40 j = 1,7 X t4(j) = t4(j) - xc X t5(j) = t5(j) - yc X t6(j) = t6(j) - zc X r4(j) = t4(j) * csa + t5(j) * ssa X r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp X r6(j) = t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp X if (r5(j).lt.1) r5(j) = 1.0 X if (j.ne.7) then X x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0 X y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0 X else X center(1) = 450.0 + (r4(j)/r5(j)) * 350.0 X center(2) = 400.0 - (r6(j)/r5(j)) * 350.0 X end if X 40 continue X radius = (2.50/r5(7) * 350.0 + .5) Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(10), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(6), istat) X if (radius.gt.0) then X call gpr_$circle (center, radius, istat) X end if X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(10), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(6), istat) X if (radius.gt.0) then X call gpr_$circle (center, radius, istat) X end if X end if X return X end X X X X subroutine strek_klingon (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir, pcen, sa, ca, sp, cp) Xc Xc STREK_KLINGON_1 draws a klingon in 3-d at xs, ys, zs as Xc seen from xc, yc, zc. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(15), y_pt(15), x2_pt(9), y2_pt(9), x3_pt(5) X integer*2 y3_pt(5), x4_pt(5), y4_pt(5), x5_pt(12), y5_pt(12) X integer*2 center(2), radius, pcen(2) X real*4 x1(15), y1(15), z1(15), x2(9), y2(9), z2(9), x3(5), y3(5) X real*4 z3(5), x4(5), y4(5), z4(5), x5(13), y5(13), z5(13) X real*4 t1(15), t2(15), t3(15), t4(15), t5(15), t6(15), t7(15) X real*4 t8(15), t9(15), t10(15), t11(15), t12(15), t13(15) X real*4 t14(15), t15(15) X real*4 r1(15), r2(15), r3(15), r4(15), r5(15), r6(15), r7(15) X real*4 r8(15), r9(15), r10(15), r11(15), r12(15), r13(15) X real*4 r14(15), r15(15) X logical dir Xc Xc saves and data for ship config Xc X save x1, x2, x3, x4, x5, y1, y2, y3, y4, y5, z1, z2, z3, z4, z5 X save x_pt, y_pt, x2_pt, y2_pt, x3_pt, y3_pt, x4_pt, y4_pt, center X save radius, x5_pt, y5_pt X data x1 /.75, 1.0, 6.5, 7.5, 7.5, 6.5, 6.5, 0.0, -6.5, -6.5, -7.5, X & -7.5, -6.5, -1.0, -.75/ X data y1 /6.0, 3.0, 0.0, 0.0, -7.5, -7.5, -1.5, -3.5, -1.5, -7.5, X & -7.5, 0.0, 0.0, 3.0, 6.0/ X data z1 /1.0, 0.8, 0.1, 0.1, 0.1, 0.1, 0.1, 1.0, 0.1, 0.1, 0.1, X & 0.1, 0.1, 0.8, 1.0/ X data x2 /0.75, 1.0, 6.5, 6.5, 0.0, -6.5, -6.5, -1.0, -0.75/ X data y2 /6.0, 3.0, 0.0, -1.5, -3.5, -1.5, 0.0, 3.0, 6.0/ X data z2 /-1.0, -0.8, -0.1, -0.1, -1.0, -0.1, -0.1, -0.8, -1.0/ X data x3 /6.5, 6.5, 7.5, 7.5, 6.5/ X data y3 /0.0, -7.5, -7.5, 0.0, 0.0/ X data z3 /-2.0, -2.0, -2.0, -2.0, -2.0/ X data x4 /-6.5, -6.5, -7.5, -7.5, -6.5/ X data y4 /0.0, -7.5, -7.5, 0.0, 0.0/ X data z4 /-2.0, -2.0, -2.0, -2.0, -2.0/ X data x5 /7.5, 7.5, 7.5, 7.5, 6.5, 6.5, -7.5, -7.5, -7.5, -7.5, X & -6.5, -6.5, 0.0/ X data y5 /0.0, 0.0, -7.5, -7.5, -7.5, -7.5, 0.0, 0.0, -7.5, -7.5, X & -7.5, -7.5, 7.5/ X data z5 /0.1, -2.0, 0.1, -2.0, 0.1, -2.0, 0.1, -2.0, 0.1, -2.0, X & 0.1, -2.0, 1.0/ Xc Xc if dir then rotate into galatic coords Xc X if (dir) then Xc Xc rotate the points about the local position Xc X do 10 j = 1,15 X t1(j) = x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs X t2(j) = x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys X t3(j) = y1(j) * sp + z1(j) * cp + zs X 10 continue X do 20 j = 1,5 X t7(j) = x3(j) * ca - y3(j) * sa * cp + z3(j) * sa * sp + xs X t8(j) = x3(j) * sa + y3(j) * ca * cp - z3(j) * ca * sp + ys X t9(j) = y3(j) * sp + z3(j) * cp + zs X t10(j) = x4(j) * ca - y4(j) * sa * cp + z4(j) * sa * sp + xs X t11(j) = x4(j) * sa + y4(j) * ca * cp - z4(j) * ca * sp + ys X t12(j) = y4(j) * sp + z4(j) * cp + zs X 20 continue X do 30 j = 1,13 X t13(j) = x5(j) * ca - y5(j) * sa * cp + z5(j) * sa * sp + xs X t14(j) = x5(j) * sa + y5(j) * ca * cp - z5(j) * ca * sp + ys X t15(j) = y5(j) * sp + z5(j) * cp + zs X 30 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 40 j = 1,15 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X r1(j) = t1(j) * csa + t2(j) * ssa X r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X r3(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (r2(j).lt.1) r2(j) = 1.0 X x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0 X y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0 X 40 continue X do 50 j = 1,5 X t7(j) = t7(j) - xc X t8(j) = t8(j) - yc X t9(j) = t9(j) - zc X r7(j) = t7(j) * csa + t8(j) * ssa X r8(j) = -t7(j) * ssa * csp + t8(j) * csa * csp + t9(j) * ssp X r9(j) = t7(j) * ssa * ssp - t8(j) * csa * ssp + t9(j) * csp X if (r8(j).lt.1) r8(j) = 1.0 X x3_pt(j) = 450.0 + (r7(j)/r8(j)) * 350.0 X y3_pt(j) = 400.0 - (r9(j)/r8(j)) * 350.0 X t10(j) = t10(j) - xc X t11(j) = t11(j) - yc X t12(j) = t12(j) - zc X r10(j) = t10(j) * csa + t11(j) * ssa X r11(j) = -t10(j) * ssa * csp + t11(j) * csa * csp + t12(j) X & * ssp X r12(j) = t10(j) * ssa * ssp - t11(j) * csa * ssp + t12(j) X & * csp X if (r11(j).lt.1) r11(j) = 1.0 X x4_pt(j) = 450.0 + (r10(j)/r11(j)) * 350.0 X y4_pt(j) = 400.0 - (r12(j)/r11(j)) * 350.0 X 50 continue X do 60 j = 1,13 X t13(j) = t13(j) - xc X t14(j) = t14(j) - yc X t15(j) = t15(j) - zc X r13(j) = t13(j) * csa + t14(j) * ssa X r14(j) = -t13(j) * ssa * csp + t14(j) * csa * csp + t15(j) X & * ssp X r15(j) = t13(j) * ssa * ssp - t14(j) * csa * ssp + t15(j) X & * csp X if (r14(j).lt.1) r14(j) = 1.0 X if (j.eq.13) then X center(1) = 450.0 + (r13(j)/r14(j)) * 350.0 X center(2) = 400.0 - (r15(j)/r14(j)) * 350.0 X pcen(1) = center(1) X pcen(2) = center(2) X else X x5_pt(j) = 450.0 + (r13(j)/r14(j)) * 350.0 X y5_pt(j) = 400.0 - (r15(j)/r14(j)) * 350.0 X end if X 60 continue X radius = (1.5 / r14(13) * 350.0 + .5) Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(15), istat) X call gpr_$move (x3_pt(1), y3_pt(1),istat) X call gpr_$polyline (x3_pt, y3_pt, int2(5), istat) X call gpr_$move (x4_pt(1), y4_pt(1),istat) X call gpr_$polyline (x4_pt, y4_pt, int2(5), istat) X call gpr_$multiline (x5_pt, y5_pt, int2(12), istat) X if (radius.gt.0) then X call gpr_$circle (center, radius, istat) X end if X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(15), istat) X call gpr_$move (x3_pt(1), y3_pt(1),istat) X call gpr_$polyline (x3_pt, y3_pt, int2(5), istat) X call gpr_$move (x4_pt(1), y4_pt(1),istat) X call gpr_$polyline (x4_pt, y4_pt, int2(5), istat) X call gpr_$multiline (x5_pt, y5_pt, int2(12), istat) X if (radius.gt.0) then X call gpr_$circle (center, radius, istat) X end if X end if X return X end X X X X X subroutine strek_romulan_1 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir, sa, ca, sp, cp) Xc Xc STREK_ROMULAN_1 draws a romulan in 3-d at xs, ys, zs as Xc seen from xc, yc, zc. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(9), y_pt(9), x_pt1(8), y_pt1(8), center(2,2) X integer*2 radius(2), xpt(2) X real*4 x1(9), y1(9), z1(9), x2(10), y2(10), z2(10) X real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10) X real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10) X logical dir Xc Xc saves and data for ship config Xc X save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1 X save radius X data x1 /6.5, 3.3, 0.0, -3.3, -6.5, 0.0, 6.5, 0.0, -6.5/ X data y1 /-3.5, 3.0, 5.0, 3.0, -3.5, -5.0, -3.5, -5.0, -3.5/ X data z1 /0.0, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, -1.5, 0.0/ X data x2 /0.0, 0.0, 3.3, 0.0, -3.3, 0.0, 0.0, 0.0, 7.5, -7.5/ X data y2 /5.0, -5.0, 3.0, 0.0, 3.0, 0.0, -5.0, 0.0, -3.5, -3.5/ X data z2 /0.0, 1.5, 0.0, -1.0, 0.0, -1.0, -1.5, -1.0, 0.0, 0.0/ Xc Xc if dir then rotate into galatic coords Xc X if (dir) then Xc Xc rotate the points about the local position Xc X do 10 j = 1,9 X t1(j) = x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs X t2(j) = x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys X t3(j) = y1(j) * sp + z1(j) * cp + zs X 10 continue X do 20 j = 1,10 X t4(j) = x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs X t5(j) = x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys X t6(j) = y2(j) * sp + z2(j) * cp + zs X 20 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 30 j = 1,9 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X r1(j) = t1(j) * csa + t2(j) * ssa X r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X r3(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (r2(j).lt.1) r2(j) = 1.0 X x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0 X y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0 X 30 continue X do 40 j = 1,10 X t4(j) = t4(j) - xc X t5(j) = t5(j) - yc X t6(j) = t6(j) - zc X r4(j) = t4(j) * csa + t5(j) * ssa X r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp X r6(j) = t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp X if (r5(j).lt.1) r5(j) = 1.0 X if (j.le.8) then X x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0 X y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0 X else X i = j - 8 X center(i,1) = 450.0 + (r4(j)/r5(j)) * 350.0 X center(i,2) = 400.0 - (r6(j)/r5(j)) * 350.0 X end if X 40 continue X radius(1) = (1.0/r5(9) * 350.0 + .5) X radius(2) = (1.0/r5(10) * 350.0 + .5) Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(9), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(8), istat) X do 50 j = 1,2 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 50 continue X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(9), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(8), istat) X do 60 j = 1,2 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 60 continue X end if X return X end X X X X X subroutine strek_romulan_2 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir, sa, ca, sp ,cp) Xc Xc STREK_ROMULAN_2 draws a romulan in 3-d at xs, ys, zs as Xc seen from xc, yc, zc. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(9), y_pt(9), x_pt1(8), y_pt1(8), center(2,2) X integer*2 radius(2), xpt(2) X real*4 x1(9), y1(9), z1(9), x2(10), y2(10), z2(10) X real*4 t1(10), t2(10), t3(10), t4(10), t5(10), t6(10) X real*4 r1(10), r2(10), r3(10), r4(10), r5(10), r6(10) X logical dir Xc Xc saves and data for ship config Xc X save x1, x2, y1, y2, z1, z2, x_pt, y_pt, center, x_pt1, y_pt1 X save radius X data x1 /6.5, 3.3, 0.0, -3.3, -6.5, 0.0, 6.5, 0.0, -6.5/ X data y1 /-3.5, 3.0, 5.0, 3.0, -3.5, -5.0, -3.5, -5.0, -3.5/ X data z1 /0.0, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, -1.5, 0.0/ X data x2 /0.0, 0.0, 3.3, 0.0, -3.3, 0.0, 0.0, 0.0, 7.5, -7.5/ X data y2 /5.0, -5.0, 3.0, 0.0, 3.0, 0.0, -5.0, 0.0, -3.5, -3.5/ X data z2 /0.0, 1.5, 0.0, -1.0, 0.0, -1.0, -1.5, -1.0, 0.0, 0.0/ Xc Xc if dir then rotate into galatic coords Xc X if (dir) then Xc Xc rotate the points about the local position Xc X do 10 j = 1,9 X t1(j) = x1(j) * ca - y1(j) * sa * cp + z1(j) * sa * sp + xs X t2(j) = x1(j) * sa + y1(j) * ca * cp - z1(j) * ca * sp + ys X t3(j) = y1(j) * sp + z1(j) * cp + zs X 10 continue X do 20 j = 1,10 X t4(j) = x2(j) * ca - y2(j) * sa * cp + z2(j) * sa * sp + xs X t5(j) = x2(j) * sa + y2(j) * ca * cp - z2(j) * ca * sp + ys X t6(j) = y2(j) * sp + z2(j) * cp + zs X 20 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 30 j = 1,9 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X r1(j) = t1(j) * csa + t2(j) * ssa X r2(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X r3(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (r2(j).lt.1) r2(j) = 1.0 X x_pt(j) = 450.0 + (r1(j)/r2(j)) * 350.0 X y_pt(j) = 400.0 - (r3(j)/r2(j)) * 350.0 X 30 continue X do 40 j = 1,10 X t4(j) = t4(j) - xc X t5(j) = t5(j) - yc X t6(j) = t6(j) - zc X r4(j) = t4(j) * csa + t5(j) * ssa X r5(j) = -t4(j) * ssa * csp + t5(j) * csa * csp + t6(j) * ssp X r6(j) = t4(j) * ssa * ssp - t5(j) * csa * ssp + t6(j) * csp X if (r5(j).lt.1) r5(j) = 1.0 X if (j.le.8) then X x_pt1(j) = 450.0 + (r4(j)/r5(j)) * 350.0 X y_pt1(j) = 400.0 - (r6(j)/r5(j)) * 350.0 X else X i = j - 8 X center(i,1) = 450.0 + (r4(j)/r5(j)) * 350.0 X center(i,2) = 400.0 - (r6(j)/r5(j)) * 350.0 X end if X 40 continue X radius(1) = (1.0/r5(9) * 350.0 + .5) X radius(2) = (1.0/r5(10) * 350.0 + .5) Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(9), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(8), istat) X do 50 j = 1,2 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 50 continue X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(9), istat) X call gpr_$multiline (x_pt1, y_pt1, int2(8), istat) X do 60 j = 1,2 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 60 continue X end if X return X end X X X X X subroutine strek_photon_1 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_1 draws an enemy photon similar to a player photon Xc (see strek_photon_4). Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(8), y_pt(8) X integer*4 istat X real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8) X real*4 t6(8), pi, t5(8) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda, X & cdp, cda X data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/ X data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/ X data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/ X data pi /3.14159265/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X ra(x) = x * pi / 180.0 X if (dir) then X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about the local position into galatic coords Xc X do 10 j = 1,8 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 20 j = 1,8 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (t5(j).lt.1.0) t5(j) = 1.0 X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X end if X return X end X X X X X X subroutine strek_photon_2 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_2 draws an enemy photon similar to a player photon Xc (see strek_photon_4). Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(8), y_pt(8) X integer*4 istat X real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8) X real*4 t6(8), pi, t5(8) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda, X & cdp, cda X data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/ X data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/ X data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/ X data pi /3.14159265/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X ra(x) = x * pi / 180.0 X if (dir) then X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about the local position into galatic coords Xc X do 10 j = 1,8 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 20 j = 1,8 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (t5(j).lt.1.0) t5(j) = 1.0 X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X end if X return X end X X X X X X subroutine strek_photon_3 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_3 draws an enemy photon similar to a player photon Xc (see strek_photon_4). Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(8), y_pt(8) X integer*4 istat X real*4 xp(8), yp(8), zp(8), t1(8), t2(8), t3(8), t4(8) X real*4 t6(8), pi, t5(8) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, cp, sp, sa, ca, sdp, sda, X & cdp, cda X data xp /0, 3.5, -3.5, 0, 0, -3.5, 3.5, 0/ X data yp /3.0, -3.0, -3.0, 3.0, 0, -3.0, -3.0, 0/ X data zp /-2.6, -2.6, -2.6, -2.6, 2.6, -2.6, -2.6, 2.6/ X data pi /3.14159265/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X ra(x) = x * pi / 180.0 X if (dir) then X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about the local position into galatic coords Xc X do 10 j = 1,8 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 20 j = 1,8 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (t5(j).lt.1.0) t5(j) = 1.0 X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X else Xc Xc erase old lines by drawing over them in black Xc X call gpr_$move (x_pt(1), y_pt(1),istat) X call gpr_$polyline (x_pt, y_pt, int2(8), istat) X end if X return X end X X X X X X subroutine strek_photon_4 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_4 draws a player photon torpedo (or erases depending Xc on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a Xc ship with angles csa, ssa, csp, and ssp. No provision is made Xc for views that are both in front of and behind the viewer, other Xc than to do a first order correction to the projected y coord. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(14), y_pt(14) X integer*4 istat X real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14) X real*4 t6(14), pi, t5(14) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp X save ca, sa, cp, sp X data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75, X & 1.75, 1.75, -1.75/ X data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, X & -1.75, 1.75, -1.75/ X data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5, X & 2.5, -2.5/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X data pi /3.14159265/ X if (dir) then Xc Xc use double angle formulas to update rotations Xc X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about their local frame to bring them into the Xc absolute frame Xc X do 10 j = 1,14 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them into its local frame Xc X do 20 j = 1,14 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X else Xc Xc erase old lines by drawing over them again (i.e. change color to Xc black, or set xor raster op) Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X end if X return X end X X X X X X X subroutine strek_photon_5 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_5 draws a player photon torpedo (or erases depending Xc on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a Xc ship with angles csa, ssa, csp, and ssp. No provision is made Xc for views that are both in front of and behind the viewer, other Xc than to do a first order correction to the projected y coord. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(14), y_pt(14) X integer*4 istat X real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14) X real*4 t6(14), pi, t5(14) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp X save ca, sa, cp, sp X data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75, X & 1.75, 1.75, -1.75/ X data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, X & -1.75, 1.75, -1.75/ X data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5, X & 2.5, -2.5/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X data pi /3.14159265/ X if (dir) then Xc Xc use double angle formulas to update rotations Xc X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about their local frame to bring them into the Xc absolute frame Xc X do 10 j = 1,14 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them into its local frame Xc X do 20 j = 1,14 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X else Xc Xc erase old lines by drawing over them again (i.e. change color to Xc black, or set xor raster op) Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X end if X return X end X X X X X X subroutine strek_photon_6 (xc, yc, zc, xs, ys, zs, csa, ssa, csp, X & ssp, dir) Xc Xc STREK_PHOTON_6 draws a player photon torpedo (or erases depending Xc on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a Xc ship with angles csa, ssa, csp, and ssp. No provision is made Xc for views that are both in front of and behind the viewer, other Xc than to do a first order correction to the projected y coord. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 x_pt(14), y_pt(14) X integer*4 istat X real*4 xp(14), yp(14), zp(14), t1(14), t2(14), t3(14), t4(14) X real*4 t6(14), pi, t5(14) X logical dir Xc Xc data for photon config and saves Xc X save x_pt, y_pt, xp, yp, zp, pi, sda, cda, sdp, cdp X save ca, sa, cp, sp X data xp /0, 0, 0, 0, 3.5, -3.5, -1.75, 1.75, 1.75, -1.75, -1.75, X & 1.75, 1.75, -1.75/ X data yp /0, 0, -3.5, 3.5, 0, 0, -1.75, 1.75, -1.75, 1.75, 1.75, X & -1.75, 1.75, -1.75/ X data zp /3.5, -3.5, 0, 0, 0, 0, 2.5, -2.5, 2.5, -2.5, 2.5, -2.5, X & 2.5, -2.5/ X data sda, sdp, cda, cdp /2*0.0998, 2*0.995/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ X data pi /3.14159265/ X if (dir) then Xc Xc use double angle formulas to update rotations Xc X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X temp = cp X cp = cp * cdp - sp * sdp X sp = sp * cdp + sdp * temp Xc Xc rotate the points about their local frame to bring them into the Xc absolute frame Xc X do 10 j = 1,14 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp + xs X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp + ys X t3(j) = yp(j) * sp + zp(j) * cp + zs X 10 continue Xc Xc form offsets from player ship and rotate them into its local frame Xc X do 20 j = 1,14 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X 20 continue Xc Xc draw the object Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X else Xc Xc erase old lines by drawing over them again (i.e. change color to Xc black, or set xor raster op) Xc X call gpr_$multiline (x_pt, y_pt, int2(14), istat) X end if X return X end X X X X X subroutine strek_starbase (xc, yc, zc, csa, csp, ssa, ssp, dir) Xc Xc STREK_STARBASE draws a 3-d starbase at the origin as viewed Xc from xc, yc, zc, at the angle csa, csp, ssa, ssp. Xc Xc version 1 Xc -jsr 8/85 Xc X% include '/sys/ins/base.ins.ftn' X% include '/sys/ins/gpr.ins.ftn' Xc X integer*2 center(5,2), x_pt(8), y_pt(8), xpt(2) X integer*2 radius(5) X integer*4 istat X real*4 xp(13), yp(13), zp(13), radii(5), t1(13), t2(13), t3(13) X real*4 t4(13), t5(13), t6(13) X logical dir Xc Xc data for unrotated base Xc X save xp, yp, zp, radii, pi, ca, sa, cp, sp, cda, cdp, sda, sdp X save radius, center, x_pt, y_pt X data xp /0.0, 0.0, 0.0, 0.0, -7.5, -12.0, 7.5, 12.0, 0.0, 0.0, X & 0.0, -15.0, 15.0/ X data yp /0.0, 0.0, 8.66, 13.855, -4.33, -6.92, -4.33, -6.92, 0.0, X & 0.0, 17.3, -8.66, -8.66/ X data zp /10.0, 16.0, -5.0, -8.0, -5.0, -8.0, -5.0, -8.0, 0.0, X & 20.0, -10.0, -10.0, -10.0/ X data radii /10.0, 4.0, 4.0, 4.0, 4.0/ X data sda, sdp, cda, cdp /0.049979, 0.0, 0.998749, 0.0/ X data ca, cp, sa, sp /2*1.0, 2*0.0/ Xc Xc rotate and project all points Xc X if (dir) then X temp = ca X ca = ca * cda - sa * sda X sa = sa * cda + sda * temp X do 10 j = 1,13 X t1(j) = xp(j) * ca - yp(j) * sa * cp + zp(j) * sa * sp X t2(j) = xp(j) * sa + yp(j) * ca * cp - zp(j) * ca * sp X t3(j) = yp(j) * sp + zp(j) * cp X 10 continue Xc Xc form offsets from player ship and rotate them about it Xc X do 20 j = 1,13 X t1(j) = t1(j) - xc X t2(j) = t2(j) - yc X t3(j) = t3(j) - zc X t4(j) = t1(j) * csa + t2(j) * ssa X t5(j) = -t1(j) * ssa * csp + t2(j) * csa * csp + t3(j) * ssp X t6(j) = t1(j) * ssa * ssp - t2(j) * csa * ssp + t3(j) * csp X if (t5(j).lt.5.0) t5(j) = 5.0 X if (j.le.8) then X x_pt(j) = 450.0 + (t4(j)/t5(j)) * 350.0 X y_pt(j) = 400.0 - (t6(j)/t5(j)) * 350.0 X else X i = j - 8 X center(i,1) = 450.0 + (t4(j)/t5(j)) * 350.0 X center(i,2) = 400.0 - (t6(j)/t5(j)) * 350.0 X radius(i) = (radii(i) / t5(j) * 350.0 + .5) X end if X 20 continue X call gpr_$multiline (x_pt, y_pt, int2(8), istat) X do 30 j = 1,5 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 30 continue X else Xc Xc erase old figure by redrawing in black or with xor raster op Xc X call gpr_$multiline (x_pt, y_pt, int2(8), i) X do 40 j = 1,5 X xpt(1) = center(j,1) X xpt(2) = center(j,2) X if (radius(j).gt.0) then X call gpr_$circle (xpt, radius(j), istat) X end if X 40 continue X end if X return X end X X E!O!F! xstrek/original_code/strek_ships_subs.f echo xstrek/original_code/strek_startup_db.f 1>&2 sed -e 's/^X//' > xstrek/original_code/strek_startup_db.f <<'E!O!F! xstrek/original_code/strek_startup_db.f' X program strek_startup_db 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 Xc STREK_STARTUP_DB initializes the strek database. It creates Xc two files in the directory it is run in. These files are Xc STREK_INFO which contains the ship registry and STREK_TOP_SCORES Xc which contains the top ten scores. Xc Xc version 1 Xc -jsr 8/85 Xc X integer*4 last_score, score, ship_avail(3), ship_retired X character ship_name*30, capt_name*10, nick_name*10, key_file*256 X data ship_avail /3*0/ X data last_score, score, ship_retired /0, 0, 1/ X data ship_name, capt_name, nick_name /3*'unused'/ X data key_file/ ' '/ Xc Xc open and write strek_info Xc X open (unit=1, file='strek_info', form='unformatted', access= X & 'direct', recl=1000) X j = 1 X write (1,rec=1) j X write (1,rec=2) ship_name, capt_name, nick_name, key_file, X & (ship_avail(i), i=1,3), last_score, X & score, ship_retired X close(1) Xc Xc open and write strek_top_scores Xc X open(unit=1,file='strek_top_scores',recl=1000, X & form = 'formatted') X do 10 j = 1,10 X write (1,110) capt_name, ship_name, score X 10 continue X110 format (a10, a30, i10) X close(1) X stop X end X E!O!F! xstrek/original_code/strek_startup_db.f echo xstrek/original_code/strek_stats.f 1>&2 sed -e 's/^X//' > xstrek/original_code/strek_stats.f <<'E!O!F! xstrek/original_code/strek_stats.f' X program strek_stats 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_STATS allows the user to peruse the STREK database without Xc playing the game. Xc Xc version 1 Xc -jsr 8/85 Xc X character*1 answer Xc Xc begin loop over options Xc X 10 continue X print*,' ' X print*,'Enter <r> to view the ship registry,' X print*,' <s> to view the top ten scores or' X print*,' <return> to quit.' X print*,' ' X read(*,'(a)') answer X if (answer.eq.'r') then X call strek_ships X goto 10 X else if (answer.eq.'s') then X call strek_scores X goto 10 X else X stop X end if X end E!O!F! xstrek/original_code/strek_stats.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