/* strek_graphics_subs.f -- translated by f2c (version of 19 December 1990 16:50:21). You must link the resulting object file with the libraries: -lF77 -lI77 -lm -lc (in that order) */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__0 = 0; static integer c__2 = 2; static integer c__23 = 23; static integer c__26 = 26; static integer c__18 = 18; static integer c__21 = 21; static integer c__5 = 5; static integer c__6 = 6; static integer c__7 = 7; static integer c__4 = 4; static integer c__3 = 3; /* Subroutine */ int strek_screen_init__(bitmap_desc__, font_3__, font_4__) integer *bitmap_desc__, *font_3__, *font_4__; { /* Initialized data */ static shortint size[2] = { 1024,1024 }; static integer value[2] = { 0,16777215 }; /* Builtin functions */ /* Subroutine */ int s_stop(), s_copy(); /* Local variables */ extern /* Subroutine */ int gprsetfillvalue_(), gprsetdrawvalue_(), gprsettextvalue_(); static char text[30]; static real gprright; extern /* Subroutine */ int gprrectangle_(), gprinqconfig_(), gprsetclipwindow_(), gprsetclippingactive_(), gprcircle_(); static integer font_1__, font_2__; static real gprborrow; static shortint config, radius, window[4] /* was [2][2] */; static integer status; static shortint pt1[2]; extern /* Subroutine */ int gprsettextbackgroundvalue_(); static real gprcolor1024x800x4, gprcolor1024x800x8; extern /* Subroutine */ int gprsetcolormap_(), gprsettextpath_(); static shortint xpt, ypt; extern /* Subroutine */ int gprsettextfont_(); static real gprcolor1024x1024x4, gprcolor1024x1024x8; extern /* Subroutine */ int gprinit_(), gprmove_(), gprcirclefilled_(), gprtext_(), gprloadfontfile_(); /* ******************************************************************* */ /* ***** ***** */ /* ***** STAR TREK VERSION 3.0 ***** */ /* ***** ***** */ /* ***** written by ***** */ /* ***** ***** */ /* ***** Justin S. Revenaugh ***** */ /* ***** ***** */ /* ***** 7/87 ***** */ /* ***** ***** */ /* ***** Massachussetts Institute of Technology ***** */ /* ***** Department of Earth, Atmospheric and Planetary Science ***** */ /* ***** ***** */ /* ******************************************************************* */ /* STREK_SCREEN_INIT sets up the static display panels for */ /* STREK. Used prior to any other graphics calls. */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* data for screen panels */ /* init screen in borrow mode (1024x1024) */ gprinqconfig_(&config, &status); gprinit_(&gprborrow, &c__1, size, &c__0, bitmap_desc__, &status); if (status != 0) { /* call errorprint (status) */ s_stop("", 0L); } if ((real) config == gprcolor1024x1024x4 || (real) config == gprcolor1024x1024x8 || (real) config == gprcolor1024x800x4 || ( real) config == gprcolor1024x800x8) { gprsetcolormap_(&c__0, &c__2, value, &status); } /* load all fonts needed */ gprloadfontfile_("/sys/dm/fonts/nonie.r.8", &c__23, &font_1__, &status, 23L); gprloadfontfile_("/sys/dm/fonts/scvc8x16.i.r", &c__26, &font_2__, &status, 26L); gprloadfontfile_("/sys/dm/fonts/scvc5x10.r.b", &c__26, font_3__, &status, 26L); gprloadfontfile_("/sys/dm/fonts/f5x9", &c__18, font_4__, &status, 18L); gprsettextpath_(&gprright, &status); /* call gprsettextbackgroundvalue (-1,status) */ gprsettextbackgroundvalue_(&c__1, &status); /* set values for draws and fills */ gprsetdrawvalue_(&c__1, &status); gprsetfillvalue_(&c__1, &status); /* fill in rectangular border */ window[0] = 0; window[1] = 0; window[2] = 900; window[3] = 800; gprrectangle_(window, &status); gprsetfillvalue_(&c__0, &status); window[0] = 100; window[1] = 100; window[2] = 700; window[3] = 600; gprrectangle_(window, &status); window[0] = 100; window[1] = 710; window[2] = 700; window[3] = 80; gprrectangle_(window, &status); gprsetfillvalue_(&c__1, &status); /* put in text on all static panels */ /* call gprsetclippingactive (.true.,status) */ xpt = 15; ypt = 25; gprsettextfont_(&font_2__, &status); gprsettextvalue_(&c__0, &status); gprmove_(&xpt, &ypt, &status); s_copy(text, "Star Trek Version 3.0", 30L, 21L); gprtext_(text, &c__21, &status, 30L); gprsettextfont_(&font_1__, &status); xpt = 10; ypt = 150; gprmove_(&xpt, &ypt, &status); s_copy(text, "Speed", 30L, 5L); gprtext_(text, &c__5, &status, 30L); xpt = 10; ypt = 250; gprmove_(&xpt, &ypt, &status); s_copy(text, "Energy", 30L, 6L); gprtext_(text, &c__6, &status, 30L); xpt = 10; ypt = 350; gprmove_(&xpt, &ypt, &status); s_copy(text, "Photons", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 10; ypt = 450; gprmove_(&xpt, &ypt, &status); s_copy(text, "Phasers", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 10; ypt = 550; gprmove_(&xpt, &ypt, &status); s_copy(text, "Tractor", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 17; ypt = 755; gprmove_(&xpt, &ypt, &status); s_copy(text, "Com:", 30L, 4L); gprtext_(text, &c__4, &status, 30L); xpt = 110; ypt = 75; gprmove_(&xpt, &ypt, &status); s_copy(text, "X-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 310; ypt = 75; gprmove_(&xpt, &ypt, &status); s_copy(text, "Y-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 510; ypt = 75; gprmove_(&xpt, &ypt, &status); s_copy(text, "Z-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 810; ypt = 125; gprmove_(&xpt, &ypt, &status); s_copy(text, "Scanner", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 810; ypt = 200; gprmove_(&xpt, &ypt, &status); s_copy(text, "X-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 810; ypt = 275; gprmove_(&xpt, &ypt, &status); s_copy(text, "Y-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 810; ypt = 350; gprmove_(&xpt, &ypt, &status); s_copy(text, "Z-Coor:", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 810; ypt = 425; gprmove_(&xpt, &ypt, &status); s_copy(text, "Range:", 30L, 6L); gprtext_(text, &c__6, &status, 30L); /* insert scanner windows */ gprsetfillvalue_(&c__0, &status); pt1[0] = 850; pt1[1] = 540; radius = 45; gprcirclefilled_(pt1, &radius, &status); pt1[1] = 650; gprcirclefilled_(pt1, &radius, &status); gprsettextfont_(font_4__, &status); xpt = 708; ypt = 33; gprmove_(&xpt, &ypt, &status); s_copy(text, "Enemy 1", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 708; ypt = 73; gprmove_(&xpt, &ypt, &status); s_copy(text, "Enemy 2", 30L, 7L); gprtext_(text, &c__7, &status, 30L); xpt = 819; ypt = 33; gprmove_(&xpt, &ypt, &status); s_copy(text, "Low E", 30L, 5L); gprtext_(text, &c__5, &status, 30L); xpt = 815; ypt = 73; gprmove_(&xpt, &ypt, &status); s_copy(text, "Nav On", 30L, 6L); gprtext_(text, &c__6, &status, 30L); xpt = 810; ypt = 490; s_copy(text, "X", 30L, 1L); gprmove_(&xpt, &ypt, &status); gprtext_(text, &c__1, &status, 30L); xpt = 885; ypt = 490; s_copy(text, "Y", 30L, 1L); gprmove_(&xpt, &ypt, &status); gprtext_(text, &c__1, &status, 30L); xpt = 810; ypt = 600; s_copy(text, "Z", 30L, 1L); gprmove_(&xpt, &ypt, &status); gprtext_(text, &c__1, &status, 30L); xpt = 885; s_copy(text, "Y", 30L, 1L); gprmove_(&xpt, &ypt, &status); gprtext_(text, &c__1, &status, 30L); gprsettextfont_(&font_2__, &status); /* put logo in lower right corner */ window[0] = 810; window[1] = 710; window[2] = 80; window[3] = 80; gprrectangle_(window, &status); pt1[0] = 850; pt1[1] = 765; radius = 18; gprcircle_(pt1, &radius, &status); pt1[0] = 850; pt1[1] = 765; radius = 6; gprcircle_(pt1, &radius, &status); gprsetfillvalue_(&c__1, &status); window[0] = 832; window[1] = 715; window[2] = 5; window[3] = 30; gprrectangle_(window, &status); window[0] = 863; gprrectangle_(window, &status); window[0] = 847; window[1] = 730; window[2] = 6; window[3] = 17; gprrectangle_(window, &status); /* load permanent font */ gprsettextfont_(font_4__, &status); gprsettextbackgroundvalue_(&c__1, &status); gprsetdrawvalue_(&c__1, &status); /* set clipping window limits */ window[0] = 100; window[1] = 100; window[2] = 700; window[3] = 600; gprsetclipwindow_(window, &status); gprsetclippingactive_(&c__1, &status); /* return to main program */ return 0; } /* strek_screen_init__ */ /* Subroutine */ int strek_update_panel__(speed, power, photons, phase, tract, xc, yc, zc, scan, txc, tyc, tzc, trange, scan_ob__) integer *speed, *power, *photons; logical *phase, *tract; integer *xc, *yc, *zc; logical *scan; integer *txc, *tyc, *tzc, *trange, *scan_ob__; { /* Initialized data */ static shortint x_pt__[15] = { 10,10,10,20,20,200,400,600,820,810,810,810, 810,770,770 }; static shortint y_pt__[15] = { 190,290,390,490,590,75,75,75,155,230,305, 380,455,35,75 }; static char active[7+1] = " active"; static char down[7+1] = " down "; static integer length = 7; static integer n = 1; static logical absol = TRUE_; /* Format strings */ static char fmt_100[] = "(i7)"; /* Builtin functions */ integer s_wsfi(), do_fio(), e_wsfi(); /* Subroutine */ int s_copy(); /* Local variables */ static char text[7]; extern /* Subroutine */ int gprsetclippingactive_(); static integer status; extern /* Subroutine */ int gprmove_(), gprtext_(); /* Fortran I/O blocks */ static icilist io___30 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___31 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___32 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___33 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___34 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___35 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___36 = { 0, text, 0, "(4x, i1)", 7, 1 }; static icilist io___37 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___38 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___39 = { 0, text, 0, fmt_100, 7, 1 }; static icilist io___40 = { 0, text, 0, fmt_100, 7, 1 }; /* STREK_UPDATE PANEL writes the revised panel data (not com line). */ /* Assumes the proper font and text value are loaded. Font */ /* background shouldn't be transparent. Handles clipping window. */ /* Only certain portions are refreshed each pass (this routine */ /* or GPR text to be more specific is slow). */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* data for move statements */ /* data for text lines */ /* deactivate clipping window */ gprsetclippingactive_(&c__0, &status); /* panel numbers are encoded into text which is then written */ if (n == 1) { s_wsfi(&io___30); do_fio(&c__1, (char *)&(*speed), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(x_pt__, y_pt__, &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___31); do_fio(&c__1, (char *)&(*power), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[1], &y_pt__[1], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___32); do_fio(&c__1, (char *)&(*photons), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[2], &y_pt__[2], &status); gprtext_(text, &length, &status, 7L); if (*phase) { s_copy(text, active, 7L, 7L); } else { s_copy(text, down, 7L, 7L); } gprmove_(&x_pt__[3], &y_pt__[3], &status); gprtext_(text, &length, &status, 7L); } else if (n == 2) { if (absol) { s_wsfi(&io___33); do_fio(&c__1, (char *)&(*xc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[5], &y_pt__[5], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___34); do_fio(&c__1, (char *)&(*yc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[6], &y_pt__[6], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___35); do_fio(&c__1, (char *)&(*zc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[7], &y_pt__[7], &status); gprtext_(text, &length, &status, 7L); } absol = ! absol; } else if (n == 3) { if (*tract) { s_copy(text, active, 7L, 7L); } else { s_copy(text, down, 7L, 7L); } gprmove_(&x_pt__[4], &y_pt__[4], &status); gprtext_(text, &length, &status, 7L); if (*scan) { s_wsfi(&io___36); do_fio(&c__1, (char *)&(*scan_ob__), (ftnlen)sizeof(integer)); e_wsfi(); } else { s_copy(text, down, 7L, 7L); } gprmove_(&x_pt__[8], &y_pt__[8], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___37); do_fio(&c__1, (char *)&(*txc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[9], &y_pt__[9], &status); gprtext_(text, &length, &status, 7L); } else { n = 0; s_wsfi(&io___38); do_fio(&c__1, (char *)&(*tyc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[10], &y_pt__[10], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___39); do_fio(&c__1, (char *)&(*tzc), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[11], &y_pt__[11], &status); gprtext_(text, &length, &status, 7L); s_wsfi(&io___40); do_fio(&c__1, (char *)&(*trange), (ftnlen)sizeof(integer)); e_wsfi(); gprmove_(&x_pt__[12], &y_pt__[12], &status); gprtext_(text, &length, &status, 7L); } ++n; /* formats */ /* L110: */ /* reactivate clipping */ gprsetclippingactive_(&c__1, &status); /* return to main */ return 0; } /* strek_update_panel__ */ /* Subroutine */ int strek_flashers__(object, lock_on__, energy, bitmap_desc__) logical *object, *lock_on__; real *energy; integer *bitmap_desc__; { /* Initialized data */ static logical old[4] = { FALSE_,FALSE_,FALSE_,FALSE_ }; static integer count = 0; static shortint wind_1__[4] /* was [2][2] */ = { 695,18,72,24 }; static shortint wind_2__[4] /* was [2][2] */ = { 695,58,72,24 }; static shortint wind_3__[4] /* was [2][2] */ = { 799,58,72,24 }; static shortint wind_4__[4] /* was [2][2] */ = { 799,18,72,24 }; static shortint dest_1__[2] = { 695,18 }; static shortint dest_2__[2] = { 695,58 }; static shortint dest_3__[2] = { 799,58 }; static shortint dest_4__[2] = { 799,18 }; static shortint zero = 0; static shortint three = 3; static shortint ten = 10; static logical low_e__; extern /* Subroutine */ int gprsetclippingactive_(), gprbitblt_(); static integer status; extern /* Subroutine */ int gprsetrasterop_(); /* STREK_FLASHERS flashes warning lights for ships and */ /* low energy. */ /* version 1 */ /* -jsr */ /* cycle through the four warning lights, if they need */ /* to be reversed then reverse them, simple huh? */ ++count; if (count > 4) { count = 0; if (object[2] && ! old[0]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_1__, &zero, dest_1__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[0] = ! old[0]; } else if (! object[2] && old[0]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_1__, &zero, dest_1__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[0] = ! old[0]; } if (object[3] && ! old[1]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_2__, &zero, dest_2__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[1] = ! old[1]; } else if (! object[3] && old[1]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_2__, &zero, dest_2__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[1] = ! old[1]; } if (*lock_on__ && ! old[2]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_3__, &zero, dest_3__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[2] = ! old[2]; } else if (! (*lock_on__) && old[2]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_3__, &zero, dest_3__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[2] = ! old[2]; } low_e__ = FALSE_; if (*energy < (float)50.) { low_e__ = TRUE_; } if (low_e__ && ! old[3]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_4__, &zero, dest_4__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[3] = ! old[3]; } else if (! low_e__ && old[3]) { gprsetrasterop_(&zero, &ten, &status); gprsetclippingactive_(&c__0, &status); gprbitblt_(bitmap_desc__, wind_4__, &zero, dest_4__, &zero, & status); gprsetrasterop_(&zero, &three, &status); gprsetclippingactive_(&c__1, &status); old[3] = ! old[3]; } } return 0; } /* strek_flashers__ */ /* Subroutine */ int strek_x_hairs__() { /* Initialized data */ static shortint x_pts__[4] = { 440,460,460,440 }; static shortint y_pts__[4] = { 410,390,410,390 }; static integer num_pos__ = 4; static integer count = 1; extern /* Subroutine */ int gprmultiline_(); static integer status; /* STREK_X_HAIRS draws the cross-hairs at the screen center. */ /* Since these don't move and should superimpose upon other */ /* objects they are redrawn instead of bit blt'ed. Assumes */ /* draw value is 1. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* call multiline for cross-hairs */ if (count == 3) { gprmultiline_(x_pts__, y_pts__, &num_pos__, &status); count = 0; } ++count; return 0; } /* strek_x_hairs__ */ /* Subroutine */ int strek_message__(message, num_lines__, message_len) char *message; integer *num_lines__; ftnlen message_len; { /* Initialized data */ static shortint window[4] /* was [2][2] */ = { 100,710,700,80 }; static shortint x_pt__ = 110; static shortint y_pt__[3] = { 730,750,770 }; static integer length = 80; /* System generated locals */ integer i__1; /* Local variables */ extern /* Subroutine */ int gprsetfillvalue_(), gprsettextvalue_(), gprrectangle_(); static integer j; extern /* Subroutine */ int gprsetclippingactive_(); static integer status; extern /* Subroutine */ int gprsettextbackgroundvalue_(), gprmove_(), gprtext_(); /* STREK_MESSAGE prints a message in the com window. */ /* Message is an array of 3 char*80 strings, num_lines is the */ /* number to print on this call (0-3). Zero lines implies */ /* clearing the message block of all current messages. */ /* Handles the clipping window and a text value commands */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* text placement data */ /* Parameter adjustments */ message -= 80; /* Function Body */ /* deactivate clipping window */ gprsetclippingactive_(&c__0, &status); /* if num_lines is zero erase message block */ if (*num_lines__ == 0) { gprsetfillvalue_(&c__0, &status); gprrectangle_(window, &status); gprsetfillvalue_(&c__1, &status); gprsetclippingactive_(&c__1, &status); return 0; } /* set text values and write message */ gprsettextvalue_(&c__1, &status); gprsettextbackgroundvalue_(&c__0, &status); i__1 = *num_lines__; for (j = 1; j <= i__1; ++j) { gprmove_(&x_pt__, &y_pt__[j - 1], &status); gprtext_(message + j * 80, &length, &status, 80L); /* L10: */ } /* reset text values and clipping window */ gprsettextvalue_(&c__0, &status); gprsettextbackgroundvalue_(&c__1, &status); gprsetclippingactive_(&c__1, &status); /* return to main program */ return 0; } /* strek_message__ */ /* Subroutine */ int strek_draw_phasers__(x_pt__, y_pt__) integer *x_pt__, *y_pt__; { extern /* Subroutine */ int gprsetdrawvalue_(); static real yoff; static integer j; static shortint xpt_l__, xpt_r__; static real xoff_l__, xoff_r__; static integer status; static shortint ypt; extern /* Subroutine */ int gprline_(), gprmove_(); /* STREK_DRAW_PHASERS - draws the phasers to the target point */ /* (x_pt,y_pt). This is all done in stop action (light speed */ /* and everthing like that there). Handles all gpr actions */ /* needed and returns them to normal. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* find the incremental offsets of rays */ xoff_l__ = (*x_pt__ - 100) / (float)20.; xoff_r__ = (*x_pt__ - 800) / (float)20.; yoff = (*y_pt__ - 700) / (float)20.; /* begin drawing lines using move and line */ for (j = 1; j <= 20; ++j) { xpt_l__ = (j - 1) * xoff_l__ + 100; ypt = (j - 1) * yoff + 700; gprmove_(&xpt_l__, &ypt, &status); xpt_l__ += xoff_l__; ypt += yoff; gprline_(&xpt_l__, &ypt, &status); xpt_r__ = (j - 1) * xoff_r__ + 800; ypt = (j - 1) * yoff + 700; gprmove_(&xpt_r__, &ypt, &status); xpt_r__ += xoff_r__; ypt += yoff; gprline_(&xpt_r__, &ypt, &status); /* L10: */ } /* erase lines slowly */ gprsetdrawvalue_(&c__0, &status); for (j = 1; j <= 20; ++j) { xpt_l__ = (j - 1) * xoff_l__ + 100; ypt = (j - 1) * yoff + 700; gprmove_(&xpt_l__, &ypt, &status); xpt_l__ += xoff_l__; ypt += yoff; gprline_(&xpt_l__, &ypt, &status); xpt_r__ = (j - 1) * xoff_r__ + 800; ypt = (j - 1) * yoff + 700; gprmove_(&xpt_r__, &ypt, &status); xpt_r__ += xoff_r__; ypt += yoff; gprline_(&xpt_r__, &ypt, &status); /* L20: */ } /* return to calling sub */ gprsetdrawvalue_(&c__1, &status); return 0; } /* strek_draw_phasers__ */ /* Subroutine */ int strek_damage_info__(d_pct__, capt_name__, nick_name__, capt_name_len, nick_name_len) real *d_pct__; char *capt_name__, *nick_name__; ftnlen capt_name_len; ftnlen nick_name_len; { /* Initialized data */ static char message[80*3+1] = " engine 1 engine 2 phaser battery \ scanner tractor "; /* System generated locals */ address a__1[2]; integer i__1[2]; /* Builtin functions */ integer s_wsfi(), do_fio(), e_wsfi(); /* Subroutine */ int s_cat(); /* Local variables */ static integer i, j; static real total; extern /* Subroutine */ int strek_message__(); /* Fortran I/O blocks */ static icilist io___76 = { 0, message+80, 0, "(6f10.2)", 80, 1 }; /* STREK_DAMAGE_INFO documents on the com line the current */ /* ship damages including a diagnostic from Scotty. */ /* version 1 */ /* -jsr 8/85 */ /* Parameter adjustments */ --d_pct__; /* Function Body */ /* encode damage pecentiles */ s_wsfi(&io___76); for (i = 1; i <= 6; ++i) { do_fio(&c__1, (char *)&d_pct__[i], (ftnlen)sizeof(real)); } e_wsfi(); /* add percents */ total = (float)0.; for (j = 1; j <= 6; ++j) { total += d_pct__[j]; /* L10: */ } /* pick Scotty's message */ if (total > (float)4.8) { /* Writing concatenation */ i__1[0] = 32, a__1[0] = "Aye, there's no problem captain "; i__1[1] = 10, a__1[1] = capt_name__; s_cat(message + 160, a__1, i__1, &c__2, 80L); } else if (total <= (float)4.8 && total > (float)3.) { /* Writing concatenation */ i__1[0] = 21, a__1[0] = "She'll hold together "; i__1[1] = 10, a__1[1] = nick_name__; s_cat(message + 160, a__1, i__1, &c__2, 80L); } else { /* Writing concatenation */ i__1[0] = 39, a__1[0] = "She can't take much more of this abuse "; i__1[1] = 10, a__1[1] = nick_name__; s_cat(message + 160, a__1, i__1, &c__2, 80L); } strek_message__(message, &c__3, 80L); return 0; } /* strek_damage_info__ */ /* Subroutine */ int strek_number_objects__(pos_store__, orange, object, dir) integer *pos_store__; real *orange; logical *object, *dir; { /* Initialized data */ static char text[1*10+1] = "0123456789"; static shortint x_pt__, y_pt__; extern /* Subroutine */ int gprsettextvalue_(); static integer j, status; extern /* Subroutine */ int gprsettextbackgroundvalue_(), gprmove_(), gprtext_(); /* STREK_NUMBER_OBJECTS writes the unique STREK object number */ /* next to screen objects. Assumes proper font, raster_op and */ /* clip window status. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* Parameter adjustments */ pos_store__ -= 10; /* Function Body */ if (*dir) { gprsettextvalue_(&c__1, &status); gprsettextbackgroundvalue_(&c__0, &status); } else { gprsettextvalue_(&c__0, &status); gprsettextbackgroundvalue_(&c__0, &status); } /* loop over objects */ for (j = 0; j <= 9; ++j) { if (object[j] && orange[j] < (float)6.4e5) { x_pt__ = pos_store__[j + 10]; y_pt__ = pos_store__[j + 20]; gprmove_(&x_pt__, &y_pt__, &status); gprtext_(text + j, &c__1, &status, 1L); } /* L10: */ } gprsettextvalue_(&c__0, &status); gprsettextbackgroundvalue_(&c__1, &status); return 0; } /* strek_number_objects__ */ /* Subroutine */ int strek_scanner__(rox, roy, roz, object, dir) real *rox, *roy, *roz; logical *object, *dir; { /* Initialized data */ static real max_ = (float)3.6e5; static real check = (float)600.; static real scale = (float).0666666; static shortint xpt[10] = { 0,0,0,0,0,0,0,0,0,0 }; static shortint ypt[10] = { 0,0,0,0,0,0,0,0,0,0 }; static shortint xpt2[10] = { 0,0,0,0,0,0,0,0,0,0 }; static shortint ypt2[10] = { 0,0,0,0,0,0,0,0,0,0 }; static logical erase[10] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_, FALSE_,FALSE_,FALSE_,FALSE_ }; /* System generated locals */ real r__1, r__2, r__3; /* Local variables */ static integer j; extern /* Subroutine */ int gprsetclippingactive_(); static real check1; static shortint xt, yt; static integer status; extern /* Subroutine */ int gprline_(), gprmove_(); /* STREK_SCANNER maintains the scanner windows. */ /* version 1 */ /* -jsr 8/85 */ /* turn off clipping */ gprsetclippingactive_(&c__0, &status); /* if refreshing then compute projected postions */ if (*dir) { for (j = 0; j <= 9; ++j) { erase[j] = FALSE_; if (object[j]) { if ((r__1 = rox[j], dabs(r__1)) < check && (r__2 = roy[j], dabs(r__2)) < check && (r__3 = roz[j], dabs(r__3)) < check) { /* Computing 2nd power */ r__1 = rox[j]; /* Computing 2nd power */ r__2 = roy[j]; check1 = r__1 * r__1 + r__2 * r__2; if (check1 < max_) { /* Computing 2nd power */ r__1 = roz[j]; /* Computing 2nd power */ r__2 = roy[j]; check1 = r__1 * r__1 + r__2 * r__2; if (check1 < max_) { erase[j] = TRUE_; xpt[j] = rox[j] * scale + 850; ypt[j] = -(doublereal)roy[j] * scale + 540; xpt2[j] = roy[j] * scale + 850; ypt2[j] = -(doublereal)roz[j] * scale + 650; gprmove_(&xpt[j], &ypt[j], &status); xt = xpt[j] + 1; yt = ypt[j] + 1; gprline_(&xt, &yt, &status); gprmove_(&xpt2[j], &ypt2[j], &status); xt = xpt2[j] + 1; yt = ypt2[j] + 1; gprline_(&xt, &yt, &status); } } } } /* L10: */ } /* plot a dot at the center of each (player ship) */ xt = 850; yt = 540; gprmove_(&xt, &yt, &status); gprline_(&xt, &yt, &status); yt = 650; gprmove_(&xt, &yt, &status); gprline_(&xt, &yt, &status); /* using previous position erase the current lines by redrawing */ /* in black */ } else { for (j = 0; j <= 9; ++j) { if (erase[j]) { gprmove_(&xpt[j], &ypt[j], &status); xt = xpt[j] + 1; yt = ypt[j] + 1; gprline_(&xt, &yt, &status); gprmove_(&xpt2[j], &ypt2[j], &status); xt = xpt2[j] + 1; yt = ypt2[j] + 1; gprline_(&xt, &yt, &status); } /* L20: */ } } gprsetclippingactive_(&c__1, &status); return 0; } /* strek_scanner__ */ /* Subroutine */ int strek_phaser_ship__(x1, y1, pcen, seed) real *x1, *y1; shortint *pcen; real *seed; { extern /* Subroutine */ int rand_(), gprsetdrawvalue_(); static real x_pt__, y_pt__; static integer j; static real xoff_1__, xoff_2__, yoff_1__, yoff_2__; static integer status; extern /* Subroutine */ int gprline_(), gprmove_(); static integer px_1__, px_2__, py_1__, py_2__; static shortint xpt1, xpt2, ypt1, ypt2; /* STREK_PHASER_SHIP draws phasers fire lines from an enemy */ /* ship to the player ship in stop time action. Lines are */ /* then erased. Handles all GPR calls needed . */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* if ship is to far off the screen or behind the player ship */ /* then don't execute. */ /* Parameter adjustments */ --pcen; /* Function Body */ x_pt__ = *x1; y_pt__ = *y1; if (x_pt__ == (float)1e3 && y_pt__ == (float)1e3) { return 0; } x_pt__ = (real) pcen[1]; y_pt__ = (real) pcen[2]; /* randomly find position of hit on screen */ rand_(seed); if (*seed < (float).25) { px_1__ = 800; rand_(seed); py_1__ = *seed * 600 + 100; } else if (*seed < (float).5 && *seed >= (float).25) { px_1__ = 100; rand_(seed); py_1__ = *seed * 600 + 100; } else if (*seed < (float).75 && *seed >= (float).5) { py_1__ = 100; rand_(seed); px_1__ = *seed * 700 + 100; } else { py_1__ = 700; rand_(seed); px_1__ = *seed * 700 + 100; } rand_(seed); if (*seed < (float).25) { px_2__ = 800; rand_(seed); py_2__ = *seed * 600 + 100; } else if (*seed < (float).5 && *seed >= (float).25) { px_2__ = 100; rand_(seed); py_2__ = *seed * 600 + 100; } else if (*seed < (float).75 && *seed >= (float).5) { py_2__ = 100; rand_(seed); px_2__ = *seed * 700 + 100; } else { py_2__ = 700; rand_(seed); px_2__ = *seed * 700 + 100; } /* find the incremental offsets of rays */ xoff_1__ = (px_1__ - x_pt__) / (float)20.; xoff_2__ = (px_2__ - x_pt__) / (float)20.; yoff_1__ = (py_1__ - y_pt__) / (float)20.; yoff_2__ = (py_2__ - y_pt__) / (float)20.; /* begin drawing lines using move and line */ for (j = 1; j <= 20; ++j) { xpt1 = x_pt__ + (j - 1) * xoff_1__; ypt1 = y_pt__ + (j - 1) * yoff_1__; gprmove_(&xpt1, &ypt1, &status); xpt1 += xoff_1__; ypt1 += yoff_1__; gprline_(&xpt1, &ypt1, &status); xpt2 = x_pt__ + (j - 1) * xoff_2__; ypt2 = y_pt__ + (j - 1) * yoff_2__; gprmove_(&xpt2, &ypt2, &status); xpt2 += xoff_2__; ypt2 += yoff_2__; gprline_(&xpt2, &ypt2, &status); /* L10: */ } /* erase lines slowly */ gprsetdrawvalue_(&c__0, &status); for (j = 1; j <= 20; ++j) { xpt1 = x_pt__ + (j - 1) * xoff_1__; ypt1 = y_pt__ + (j - 1) * yoff_1__; gprmove_(&xpt1, &ypt1, &status); xpt1 += xoff_1__; ypt1 += yoff_1__; gprline_(&xpt1, &ypt1, &status); xpt2 = x_pt__ + (j - 1) * xoff_2__; ypt2 = y_pt__ + (j - 1) * yoff_2__; gprmove_(&xpt2, &ypt2, &status); xpt2 += xoff_2__; ypt2 += yoff_2__; gprline_(&xpt2, &ypt2, &status); /* L20: */ } /* return to calling sub */ gprsetdrawvalue_(&c__1, &status); return 0; } /* strek_phaser_ship__ */ /* Subroutine */ int strek_phaser_nemian__(pro_x__, pro_y__) real *pro_x__, *pro_y__; { extern /* Subroutine */ int gprsetdrawvalue_(); static real xoff, yoff; static shortint x_pt__, y_pt__; static integer j, status; extern /* Subroutine */ int gprline_(), gprmove_(); /* STREK_PHASER_NEMIAN draws the klingon phaser fire towards */ /* Nemian freighters in stop action time. */ /* version 1 */ /* -jsr 8/85 */ /* % include '/sys/ins/base.ins.ftn' */ /* % include '/sys/ins/gpr.ins.ftn' */ /* check that phasers need to be drawn */ if (pro_x__[1] == (float)1e3 || pro_y__[1] == (float)1e3) { return 0; } /* form offsets */ xoff = (pro_x__[1] - pro_x__[2]) / (float)20.; yoff = (pro_y__[1] - pro_y__[2]) / (float)20.; /* draw phasers (1 line only) */ x_pt__ = pro_x__[2]; y_pt__ = pro_y__[2]; gprmove_(&x_pt__, &y_pt__, &status); for (j = 1; j <= 20; ++j) { x_pt__ += xoff; y_pt__ += yoff; gprline_(&x_pt__, &y_pt__, &status); /* L10: */ } /* erase lines by redrawing in black */ gprsetdrawvalue_(&c__0, &status); x_pt__ = pro_x__[2]; y_pt__ = pro_y__[2]; gprmove_(&x_pt__, &y_pt__, &status); for (j = 1; j <= 20; ++j) { x_pt__ += xoff; y_pt__ += yoff; gprline_(&x_pt__, &y_pt__, &status); /* L20: */ } /* reset color and return */ gprsetdrawvalue_(&c__1, &status); return 0; } /* strek_phaser_nemian__ */