subroutine strek_screen_init (bitmap_desc, font_3, font_4) 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_SCREEN_INIT sets up the static display panels for c STREK. Used prior to any other graphics calls. c c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 config, size(2) integer*4 font_1, font_2, font_3, font_4 integer*2 window(2,2), xpt, ypt, pt1(2), radius integer*4 status, bitmap_desc, value(2) character text*30 c c data for screen panels c data size /1024, 1024/ data value /0, 16777215/ c c init screen in borrow mode (1024x1024) c call gprinqconfig (config, status) c call gprinit (gprborrow, 1, size, 0, & bitmap_desc, status) if (status.ne.0) then c call errorprint (status) stop end if c if (config.eq.gprcolor1024x1024x4.or. & config.eq.gprcolor1024x1024x8.or. & config.eq.gprcolor1024x800x4.or. & config.eq.gprcolor1024x800x8) then call gprsetcolormap (0, 2, value, status) end if c c load all fonts needed c call gprloadfontfile ('/sys/dm/fonts/nonie.r.8',23, & font_1,status) call gprloadfontfile ('/sys/dm/fonts/scvc8x16.i.r',26, & font_2,status) call gprloadfontfile ('/sys/dm/fonts/scvc5x10.r.b',26, & font_3,status) call gprloadfontfile ('/sys/dm/fonts/f5x9',18, & font_4,status) call gprsettextpath (gprright,status) c call gprsettextbackgroundvalue (-1,status) call gprsettextbackgroundvalue (1,status) c c set values for draws and fills c call gprsetdrawvalue (1,status) call gprsetfillvalue (1,status) c c fill in rectangular border c window(1,1) = 0 window(2,1) = 0 window(1,2) = 900 window(2,2) = 800 call gprrectangle (window,status) call gprsetfillvalue (0,status) window(1,1) = 100 window(2,1) = 100 window(1,2) = 700 window(2,2) = 600 call gprrectangle (window,status) window(1,1) = 100 window(2,1) = 710 window(1,2) = 700 window(2,2) = 80 call gprrectangle (window,status) call gprsetfillvalue (1,status) c c put in text on all static panels c c call gprsetclippingactive (.true.,status) xpt = 15 ypt = 25 call gprsettextfont (font_2,status) call gprsettextvalue (0,status) call gprmove (xpt,ypt,status) text = 'Star Trek Version 3.0' call gprtext (text,21,status) call gprsettextfont (font_1,status) xpt = 10 ypt = 150 call gprmove (xpt,ypt,status) text = 'Speed' call gprtext (text,5,status) xpt = 10 ypt = 250 call gprmove (xpt,ypt,status) text = 'Energy' call gprtext (text,6,status) xpt = 10 ypt = 350 call gprmove (xpt,ypt,status) text = 'Photons' call gprtext (text,7,status) xpt = 10 ypt = 450 call gprmove (xpt,ypt,status) text = 'Phasers' call gprtext (text,7,status) xpt = 10 ypt = 550 call gprmove (xpt,ypt,status) text = 'Tractor' call gprtext (text,7,status) xpt = 17 ypt = 755 call gprmove (xpt,ypt,status) text = 'Com:' call gprtext (text,4,status) xpt = 110 ypt = 75 call gprmove (xpt,ypt,status) text = 'X-Coor:' call gprtext (text,7,status) xpt = 310 ypt = 75 call gprmove (xpt,ypt,status) text = 'Y-Coor:' call gprtext (text,7,status) xpt = 510 ypt = 75 call gprmove (xpt,ypt,status) text = 'Z-Coor:' call gprtext (text,7,status) xpt = 810 ypt = 125 call gprmove (xpt,ypt,status) text = 'Scanner' call gprtext (text,7,status) xpt = 810 ypt = 200 call gprmove (xpt,ypt,status) text = 'X-Coor:' call gprtext (text,7,status) xpt = 810 ypt = 275 call gprmove (xpt,ypt,status) text = 'Y-Coor:' call gprtext (text,7,status) xpt = 810 ypt = 350 call gprmove (xpt,ypt,status) text = 'Z-Coor:' call gprtext (text,7,status) xpt = 810 ypt = 425 call gprmove (xpt,ypt,status) text = 'Range:' call gprtext (text,6,status) c c insert scanner windows c call gprsetfillvalue (0,status) pt1(1) = 850 pt1(2) = 540 radius = 45 call gprcirclefilled (pt1, radius, status) pt1(2) = 650 call gprcirclefilled (pt1, radius, status) call gprsettextfont (font_4,status) xpt = 708 ypt = 33 call gprmove (xpt,ypt,status) text = 'Enemy 1' call gprtext (text,7,status) xpt = 708 ypt = 73 call gprmove (xpt,ypt,status) text = 'Enemy 2' call gprtext (text,7,status) xpt = 819 ypt = 33 call gprmove (xpt,ypt,status) text = 'Low E' call gprtext (text,5,status) xpt = 815 ypt = 73 call gprmove (xpt,ypt,status) text = 'Nav On' call gprtext (text,6,status) xpt = 810 ypt = 490 text = 'X' call gprmove (xpt,ypt,status) call gprtext (text,1,status) xpt = 885 ypt = 490 text = 'Y' call gprmove (xpt,ypt,status) call gprtext (text,1,status) xpt = 810 ypt = 600 text = 'Z' call gprmove (xpt,ypt,status) call gprtext (text,1,status) xpt = 885 text = 'Y' call gprmove (xpt,ypt,status) call gprtext (text,1,status) call gprsettextfont (font_2,status) c c put logo in lower right corner c window(1,1) = 810 window(2,1) = 710 window(1,2) = 80 window(2,2) = 80 call gprrectangle (window,status) pt1(1) = 850 pt1(2) = 765 radius = 18 call gprcircle (pt1,radius,status) pt1(1) = 850 pt1(2) = 765 radius = 6 call gprcircle (pt1,radius,status) call gprsetfillvalue (1,status) window(1,1) = 832 window(2,1) = 715 window(1,2) = 5 window(2,2) = 30 call gprrectangle (window,status) window(1,1) = 863 call gprrectangle (window,status) window(1,1) = 847 window(2,1) = 730 window(1,2) = 6 window(2,2) = 17 call gprrectangle (window,status) c c load permanent font c call gprsettextfont (font_4, status) call gprsettextbackgroundvalue (1, status) call gprsetdrawvalue (1, status) c c set clipping window limits c window(1,1) = 100 window(2,1) = 100 window(1,2) = 700 window(2,2) = 600 call gprsetclipwindow (window,status) call gprsetclippingactive (.true.,status) c c return to main program c return end subroutine strek_update_panel (speed, power, photons, phase, & tract, xc, yc, zc, scan, txc, tyc, & tzc, trange, scan_ob) c c STREK_UPDATE PANEL writes the revised panel data (not com line). c Assumes the proper font and text value are loaded. Font c background shouldn't be transparent. Handles clipping window. c Only certain portions are refreshed each pass (this routine c or GPR text to be more specific is slow). c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 x_pt(15), y_pt(15), xpt, ypt, wind_1(2,2) integer*4 length integer*2 dest_1(2) integer*4 speed, photons, xc, yc, zc, txc, tyc, tzc, trange integer*4 status, power, azm, angle, scan_ob logical phase, tract, scan, absol character*7 text, active, down save active down, x_pt, y_pt, length, n, absol c c data for move statements c data x_pt /10, 10, 10, 20, 20, 200, 400, 600, 820, 810, 810, & 810, 810, 770, 770/ data y_pt /190, 290, 390, 490, 590, 75, 75, 75, 155, 230, 305, & 380, 455, 35, 75/ c c data for text lines c data active, down /' active', ' down'/ data length, n / 7, 1/ data wind_1 / 695, 18, 72, 24/ data dest_1 / 695, 18/ data absol / .true./ c c deactivate clipping window c call gprsetclippingactive (.false.,status) c c panel numbers are encoded into text which is then written c if (n .eq. 1) then write (text,100) speed call gprmove (x_pt(1), y_pt(1), status) call gprtext (text, length, status) write (text,100) power call gprmove (x_pt(2), y_pt(2), status) call gprtext (text, length, status) write (text,100) photons call gprmove (x_pt(3), y_pt(3), status) call gprtext (text, length, status) if (phase) then text = active else text = down end if call gprmove (x_pt(4), y_pt(4), status) call gprtext (text, length, status) else if (n.eq.2) then if (absol) then write (text,100) xc call gprmove (x_pt(6), y_pt(6), status) call gprtext (text, length, status) write (text,100) yc call gprmove (x_pt(7), y_pt(7), status) call gprtext (text, length, status) write (text,100) zc call gprmove (x_pt(8), y_pt(8), status) call gprtext (text, length, status) end if absol = .not. absol else if (n.eq.3) then if (tract) then text = active else text = down end if call gprmove (x_pt(5), y_pt(5), status) call gprtext (text, length, status) if (scan) then write (text, '(4x, i1)') scan_ob else text = down end if call gprmove (x_pt(9), y_pt(9), status) call gprtext (text, length, status) write (text,100) txc call gprmove (x_pt(10), y_pt(10), status) call gprtext (text, length, status) else n = 0 write (text,100) tyc call gprmove (x_pt(11), y_pt(11), status) call gprtext (text, length, status) write (text,100) tzc call gprmove (x_pt(12), y_pt(12), status) call gprtext (text, length, status) write (text,100) trange call gprmove (x_pt(13), y_pt(13), status) call gprtext (text, length, status) end if n = n + 1 c c formats c 100 format (i7) 110 format (i4) c c reactivate clipping c call gprsetclippingactive (.true.,status) c c return to main c return end subroutine strek_flashers (object, lock_on, energy, bitmap_desc) c c STREK_FLASHERS flashes warning lights for ships and c low energy. c c version 1 c -jsr c integer*2 wind_1(2,2), wind_2(2,2), wind_3(2,2), wind_4(2,2) integer*2 dest_1(2), dest_2(2), dest_3(2), dest_4(2) integer*2 zero, three, ten integer*4 bitmap_desc, status, count real energy logical object(0:9), lock_on, old(4), low_e save old, wind_1, wind_2, wind_3, wind_4, count save dest_1, dest_2, dest_3, dest_4, zero, three, ten data old / 4 * .false./ data count / 0/ data wind_1 / 695, 18, 72, 24/ data wind_2 / 695, 58, 72, 24/ data wind_3 / 799, 58, 72, 24/ data wind_4 / 799, 18, 72, 24/ data dest_1 / 695, 18/ data dest_2 / 695, 58/ data dest_3 / 799, 58/ data dest_4 / 799, 18/ data zero, three, ten / 0, 3, 10/ c c cycle through the four warning lights, if they need c to be reversed then reverse them, simple huh? c count = count + 1 if (count .gt. 4) then count = 0 if (object(2) .and. (.not. old(1))) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_1, zero, dest_1, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(1) = .not. old(1) else if ((.not. object(2)) .and. old(1)) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_1, zero, dest_1, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(1) = .not. old(1) end if if (object(3) .and. (.not. old(2))) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_2, zero, dest_2, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(2) = .not. old(2) else if ((.not. object(3)) .and. old(2)) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_2, zero, dest_2, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(2) = .not. old(2) end if if (lock_on .and. (.not. old(3))) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_3, zero, dest_3, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(3) = .not. old(3) else if ((.not. lock_on) .and. old(3)) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_3, zero, dest_3, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(3) = .not. old(3) end if low_e = .false. if (energy .lt. 50.0) low_e = .true. if (low_e .and. (.not. old(4))) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_4, zero, dest_4, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(4) = .not. old(4) else if ((.not. low_e) .and. old(4)) then call gprsetrasterop (zero, ten, status) call gprsetclippingactive (.false.,status) call gprbitblt (bitmap_desc, wind_4, zero, dest_4, & zero, status) call gprsetrasterop (zero, three, status) call gprsetclippingactive (.true.,status) old(4) = .not. old(4) end if end if return end subroutine strek_x_hairs c c STREK_X_HAIRS draws the cross-hairs at the screen center. c Since these don't move and should superimpose upon other c objects they are redrawn instead of bit blt'ed. Assumes c draw value is 1. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 x_pts(4), y_pts(4) integer*4 num_pos integer*4 status, count save x_pts, y_pts, num_pos, yes data x_pts / 440, 460, 460, 440/ data y_pts / 410, 390, 410, 390/ data num_pos, count / 4, 1/ c c call multiline for cross-hairs c if (count .eq. 3) then call gprmultiline (x_pts, y_pts, num_pos, status) count = 0 end if count = count + 1 return end subroutine strek_message (message, num_lines) c c STREK_MESSAGE prints a message in the com window. c Message is an array of 3 char*80 strings, num_lines is the c number to print on this call (0-3). Zero lines implies c clearing the message block of all current messages. c Handles the clipping window and a text value commands c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 window(2,2), x_pt, y_pt(3) integer*4 length integer*4 num_lines,status character*80 message(3) save window, x_pt, y_pt, length c c text placement data c data window(1,1), window(2,1), window(1,2), window(2,2) / & 100, 710, 700, 80/ data x_pt / 110/ data y_pt / 730, 750, 770/ data length / 80/ c c deactivate clipping window c call gprsetclippingactive (.false.,status) c c if num_lines is zero erase message block c if (num_lines.eq.0) then call gprsetfillvalue (0,status) call gprrectangle (window,status) call gprsetfillvalue (1,status) call gprsetclippingactive (.true.,status) return end if c c set text values and write message c call gprsettextvalue (1,status) call gprsettextbackgroundvalue (0,status) do 10 j = 1,num_lines call gprmove (x_pt,y_pt(j),status) call gprtext (message(j),length,status) 10 continue c c reset text values and clipping window c call gprsettextvalue (0,status) call gprsettextbackgroundvalue (1,status) call gprsetclippingactive (.true.,status) c c return to main program c return end subroutine strek_draw_phasers (x_pt, y_pt) c c STREK_DRAW_PHASERS - draws the phasers to the target point c (x_pt,y_pt). This is all done in stop action (light speed c and everthing like that there). Handles all gpr actions c needed and returns them to normal. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 xpt_l, xpt_r, ypt integer*4 x_pt, y_pt, status real*4 xoff_l, xoff_r, yoff c c find the incremental offsets of rays c xoff_l = (x_pt - 100)/20.0 xoff_r = (x_pt - 800)/20.0 yoff = (y_pt - 700)/20.0 c c begin drawing lines using move and line c do 10 j = 1,20 xpt_l = 100 + (j-1)*xoff_l ypt = 700 + (j-1)*yoff call gprmove (xpt_l, ypt, status) xpt_l = xpt_l + xoff_l ypt = ypt + yoff call gprline (xpt_l, ypt, status) xpt_r = 800 + (j-1)*xoff_r ypt = 700 + (j-1)*yoff call gprmove (xpt_r, ypt, status) xpt_r = xpt_r + xoff_r ypt = ypt + yoff call gprline (xpt_r, ypt, status) 10 continue c c erase lines slowly c call gprsetdrawvalue (0, status) do 20 j = 1,20 xpt_l = 100 + (j-1)*xoff_l ypt = 700 + (j-1)*yoff call gprmove (xpt_l, ypt, status) xpt_l = xpt_l + xoff_l ypt = ypt + yoff call gprline (xpt_l, ypt, status) xpt_r = 800 + (j-1)*xoff_r ypt = 700 + (j-1)*yoff call gprmove (xpt_r, ypt, status) xpt_r = xpt_r + xoff_r ypt = ypt + yoff call gprline (xpt_r, ypt, status) 20 continue c c return to calling sub c call gprsetdrawvalue (1, status) return end subroutine strek_damage_info (d_pct, capt_name, nick_name) c c STREK_DAMAGE_INFO documents on the com line the current c ship damages including a diagnostic from Scotty. c c version 1 c -jsr 8/85 c real*4 d_pct(6), total character*10 capt_name, nick_name character*80 message(3) data message(1) /' engine 1 engine 2 phaser battery scann &er tractor'/ c c encode damage pecentiles c write (message(2),'(6f10.2)') (d_pct(i), i=1,6) c c add percents c total = 0.0 do 10 j = 1,6 total = total + d_pct(j) 10 continue c c pick Scotty's message c if (total.gt.4.8) then message(3) = 'Aye, there''s no problem captain '//capt_name else if (total.le.4.8.and.total.gt.3.0) then message(3) = 'She''ll hold together '//nick_name else message(3) = & 'She can''t take much more of this abuse '//nick_name end if call strek_message (message, 3) return end subroutine strek_number_objects (pos_store, orange, object, dir) c c STREK_NUMBER_OBJECTS writes the unique STREK object number c next to screen objects. Assumes proper font, raster_op and c clip window status. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 x_pt, y_pt integer*4 pos_store(0:9,2), status real*4 orange(0:9) logical object(0:9), dir character*1 text(0:9) save text data text/'0','1','2','3','4','5','6','7','8','9'/ if (dir) then call gprsettextvalue (1, status) call gprsettextbackgroundvalue (0, status) else call gprsettextvalue (0, status) call gprsettextbackgroundvalue (0, status) end if c c loop over objects c do 10 j = 0,9 if (object(j).and.orange(j).lt.640000.0) then x_pt = pos_store(j,1) y_pt = pos_store(j,2) call gprmove (x_pt, y_pt, status) call gprtext (text(j), 1, status) end if 10 continue call gprsettextvalue (0, status) call gprsettextbackgroundvalue (1, status) return end subroutine strek_scanner (rox, roy, roz, object, dir) c c STREK_SCANNER maintains the scanner windows. c c version 1 c -jsr 8/85 c integer*2 xpt(0:9), ypt(0:9), xpt2(0:9), ypt2(0:9) integer*2 xt, yt integer*4 status real*4 rox(0:9), roy(0:9), roz(0:9), max, check, scale logical object(0:9), dir, erase(0:9) save xpt, ypt, xpt2, ypt2, max, check, scale, erase data max, check, scale /360000.0, 600.0, 0.0666666/ data xpt, ypt, xpt2, ypt2 /40*0/ data erase /10*.false./ c c turn off clipping c call gprsetclippingactive (.false., status) c c if refreshing then compute projected postions c if (dir) then do 10 j= 0,9 erase(j) = .false. if (object(j)) then if ((abs(rox(j)).lt.check.and.abs(roy(j)).lt.check).and. & (abs(roz(j)).lt.check)) then check1 = rox(j)**2 + roy(j)**2 if (check1.lt.max) then check1 = roz(j)**2 + roy(j)**2 if (check1.lt.max) then erase(j) = .true. xpt(j) = rox(j) * scale + 850 ypt(j) = - roy(j) * scale + 540 xpt2(j) = roy(j) * scale + 850 ypt2(j) = - roz(j) * scale + 650 call gprmove (xpt(j), ypt(j), status) xt = xpt(j) + 1 yt = ypt(j) + 1 call gprline (xt, yt, status) call gprmove (xpt2(j), ypt2(j), status) xt = xpt2(j) + 1 yt = ypt2(j) + 1 call gprline (xt, yt, status) end if end if end if end if 10 continue c c plot a dot at the center of each (player ship) c xt = 850 yt = 540 call gprmove (xt, yt, status) call gprline (xt, yt, status) yt = 650 call gprmove (xt, yt, status) call gprline (xt, yt, status) c c using previous position erase the current lines by redrawing c in black c else do 20 j = 0,9 if (erase(j)) then call gprmove (xpt(j), ypt(j), status) xt = xpt(j) + 1 yt = ypt(j) + 1 call gprline (xt, yt, status) call gprmove (xpt2(j), ypt2(j), status) xt = xpt2(j) + 1 yt = ypt2(j) + 1 call gprline (xt, yt, status) end if 20 continue end if call gprsetclippingactive (.true., status) return end subroutine strek_phaser_ship (x1, y1, pcen, seed) c c STREK_PHASER_SHIP draws phasers fire lines from an enemy c ship to the player ship in stop time action. Lines are c then erased. Handles all GPR calls needed . c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 xpt1, xpt2, ypt1, ypt2, pcen(2) integer*4 status, px_1, px_2, py_1, py_2 real*4 xoff_1, xoff_2, yoff_1, yoff_2, seed, x_pt, y_pt c c if ship is to far off the screen or behind the player ship c then don't execute. c x_pt = x1 y_pt = y1 if (x_pt.eq.1000.and.y_pt.eq.1000) return x_pt = pcen(1) y_pt = pcen(2) c c randomly find position of hit on screen c call rand (seed) if (seed.lt.0.25) then px_1 = 800 call rand (seed) py_1 = 100 + 600 * seed else if (seed.lt.0.5.and.seed.ge.0.25) then px_1 = 100 call rand (seed) py_1 = 100 + 600 * seed else if (seed.lt.0.75.and.seed.ge.0.50) then py_1 = 100 call rand (seed) px_1 = 100 + 700 * seed else py_1 = 700 call rand (seed) px_1 = 100 + 700 * seed end if call rand (seed) if (seed.lt.0.25) then px_2 = 800 call rand (seed) py_2 = 100 + 600 * seed else if (seed.lt.0.5.and.seed.ge.0.25) then px_2 = 100 call rand (seed) py_2 = 100 + 600 * seed else if (seed.lt.0.75.and.seed.ge.0.50) then py_2 = 100 call rand (seed) px_2 = 100 + 700 * seed else py_2 = 700 call rand (seed) px_2 = 100 + 700 * seed end if c c find the incremental offsets of rays c xoff_1 = (px_1 - x_pt)/20.0 xoff_2 = (px_2 - x_pt)/20.0 yoff_1 = (py_1 - y_pt)/20.0 yoff_2 = (py_2 - y_pt)/20.0 c c begin drawing lines using move and line c do 10 j = 1,20 xpt1 = x_pt + (j-1)*xoff_1 ypt1 = y_pt + (j-1)*yoff_1 call gprmove (xpt1, ypt1, status) xpt1 = xpt1 + xoff_1 ypt1 = ypt1 + yoff_1 call gprline (xpt1, ypt1, status) xpt2 = x_pt + (j-1)*xoff_2 ypt2 = y_pt + (j-1)*yoff_2 call gprmove (xpt2, ypt2, status) xpt2 = xpt2 + xoff_2 ypt2 = ypt2 + yoff_2 call gprline (xpt2, ypt2, status) 10 continue c c erase lines slowly c call gprsetdrawvalue (0, status) do 20 j = 1,20 xpt1 = x_pt + (j-1)*xoff_1 ypt1 = y_pt + (j-1)*yoff_1 call gprmove (xpt1, ypt1, status) xpt1 = xpt1 + xoff_1 ypt1 = ypt1 + yoff_1 call gprline (xpt1, ypt1, status) xpt2 = x_pt + (j-1)*xoff_2 ypt2 = y_pt + (j-1)*yoff_2 call gprmove (xpt2, ypt2, status) xpt2 = xpt2 + xoff_2 ypt2 = ypt2 + yoff_2 call gprline (xpt2, ypt2, status) 20 continue c c return to calling sub c call gprsetdrawvalue (1, status) return end subroutine strek_phaser_nemian (pro_x, pro_y) c c STREK_PHASER_NEMIAN draws the klingon phaser fire towards c Nemian freighters in stop action time. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c integer*2 x_pt, y_pt integer*4 status real*4 pro_x(0:9), pro_y(0:9), xoff, yoff c c check that phasers need to be drawn c if (pro_x(1).eq.1000.0.or.pro_y(1).eq.1000.0) return c c form offsets c xoff = (pro_x(1) - pro_x(2))/20.0 yoff = (pro_y(1) - pro_y(2))/20.0 c c draw phasers (1 line only) c x_pt = pro_x(2) y_pt = pro_y(2) call gprmove (x_pt, y_pt, status) do 10 j = 1,20 x_pt = x_pt + xoff y_pt = y_pt + yoff call gprline (x_pt, y_pt, status) 10 continue c c erase lines by redrawing in black c call gprsetdrawvalue (0, status) x_pt = pro_x(2) y_pt = pro_y(2) call gprmove (x_pt, y_pt, status) do 20 j = 1,20 x_pt = x_pt + xoff y_pt = y_pt + yoff call gprline (x_pt, y_pt, status) 20 continue c c reset color and return c call gprsetdrawvalue(1, status) return end