[INHERIT('sys$library:starlet.pen')]
PROGRAM trek(input,output);

CONST {%include 'interfacdsk:[interfac.screen]scrutil.con'}
{ constants required by the screen utility }
     esc = CHR(27);
      star_base_char = '>-<';
      probe_char     = ')=(';
      star_ship_char = '<+>';
      klingon_char   = '+*+';
      romulan_char   = '=I=';
      star_char      = ' . ';
      romulan_cloak_char = chr(0) + '   ';

TYPE string = varying [255] OF CHAR;
     v_4 = VARYING [4] OF CHAR;
     {%include 'paslibdsk:[paslib]char.typ'}
     char_132 = PACKED ARRAY [1..132] OF CHAR;
     char_120 = PACKED ARRAY [1..120] OF CHAR;
     char_80 = PACKED ARRAY [1..80] OF CHAR;
     char_79 = PACKED ARRAY [1..79] OF CHAR;
     char_78 = PACKED ARRAY [1..78] OF CHAR;
     char_75 = PACKED ARRAY [1..75] OF CHAR;
     char_71 = PACKED ARRAY [1..71] OF CHAR;
     char_60 = PACKED ARRAY [1..60] OF CHAR;
     char_52 = PACKED ARRAY [1..52] OF CHAR;
     char_50 = PACKED ARRAY [1..50] OF CHAR;
     char_40 = PACKED ARRAY [1..40] OF CHAR;
     char_37 = PACKED ARRAY [1..37] OF CHAR;
     char_33 = PACKED ARRAY [1..33] OF CHAR;
     char_34 = PACKED ARRAY [1..34] OF CHAR;
     char_31 = PACKED ARRAY [1..31] OF CHAR;
     char_30 = PACKED ARRAY [1..30] OF CHAR;
     char_25 = PACKED ARRAY [1..25] OF CHAR;
     char_24 = PACKED ARRAY [1..24] OF CHAR;
     char_20 = PACKED ARRAY [1..20] OF CHAR;
     char_18 = PACKED ARRAY [1..18] OF CHAR;
     char_17 = PACKED ARRAY [1..17] OF CHAR;
     char_15 = PACKED ARRAY [1..15] OF CHAR;
     char_14 = PACKED ARRAY [1..14] OF CHAR;
     char_13 = PACKED ARRAY [1..13] OF CHAR;
     char_12 = PACKED ARRAY [1..12] OF CHAR;
     char_11 = PACKED ARRAY [1..11] OF CHAR;
     char_10 = PACKED ARRAY [1..10] OF CHAR;
     char_9 = PACKED ARRAY [1..9] OF CHAR;
     char_8 = PACKED ARRAY [1..8] OF CHAR;
     char_7 = PACKED ARRAY [1..7] OF CHAR;
     char_6 = PACKED ARRAY [1..6] OF CHAR;
     char_5 = PACKED ARRAY [1..5] OF CHAR;
     char_4 = PACKED ARRAY [1..4] OF CHAR;
     char_3 = PACKED ARRAY [1..3] OF CHAR;
     char_2 = PACKED ARRAY [1..2] OF CHAR;
     char_1 = PACKED ARRAY [1..1] OF CHAR;
     text_line = PACKED ARRAY [1..79] OF CHAR;
     text_7 = ARRAY [1..7] OF text_line;
     text_4 = ARRAY [1..4] OF text_line;
     text_3 = ARRAY [1..3] OF text_line;
     {%include 'interfacdsk:[interfac.screen]scrutil.typ'}
{ types required by the scrutil }
     $word = [WORD] -32768..32767;
     $quad = [QUAD,UNSAFE] RECORD;
        l0 : UNSIGNED;
        L1 : INTEGER;
        END;

     coordinates = RECORD
        x : INTEGER;
        y : INTEGER;
        END;

     r_star_ship = RECORD
        sector : coordinates;
        location : coordinates;
        fuel : INTEGER;
        shields : INTEGER;
        probe_cnt : INTEGER;
        photon_cnt : INTEGER;
        damage : ARRAY [1..9] OF INTEGER;
        alert_cnt,cloak_alert_cnt : INTEGER;
        END;

     r_sector = RECORD
        base : BOOLEAN;
        probe : BOOLEAN;
        END;

     romulan_ship = RECORD
        sector : coordinates;
        location : coordinates;
        target_sector : coordinates;
        cloak : BOOLEAN;
        hit : BOOLEAN;
        miss : BOOLEAN;
        strength : INTEGER;
        END;

     klingon_ship = RECORD
        sector : coordinates;
        location : coordinates;
        hit : INTEGER;
        miss : BOOLEAN;
        strength : INTEGER;
        END;

VAR {%include 'interfacdsk:[interfac.screen]scrutil.var'}
{ variables required by scrutil }
      write_buf_len,channel : $word;
      write_buf : char_80;
    rseed : INTEGER;
    sector : ARRAY [1..15,1..15] OF r_sector;
    location : ARRAY [1..15,1..15] OF V_4;
    sr_scan_on : BOOLEAN;
    star_ship : r_star_ship;
    romulan : ARRAY [1..5] OF romulan_ship;
    romulan_cnt : INTEGER;
    klingon : ARRAY [1..5] OF klingon_ship;
    klingon_cnt : INTEGER;
    alert_mess : ARRAY [20..22] OF string;
    skill_level : INTEGER;
            
[EXTERNAL]PROCEDURE lib$wait(t:REAL); EXTERN;

{%include 'paslibdsk:[paslib]zfill2.inc'}
FUNCTION zfill2(num : INTEGER) : CHAR_2;
{this routine zero fills a number}
VAR index : INTEGER;
    result : CHAR_2;
BEGIN
index := 2;
REPEAT
  result[index] := CHR(ORD('0')+ num MOD 10);
  num := num DIV 10;
  index := index - 1;
UNTIL index = 0;
zfill2 := result;
END;
{%include 'paslibdsk:[paslib]zfill4.inc'}
FUNCTION zfill4(num : INTEGER) : CHAR_4;
{this routine zero fills a number}
VAR index : INTEGER;
    result : CHAR_4;
BEGIN
index := 4;
REPEAT
  result[index] := CHR(ORD('0')+ num MOD 10);
  num := num DIV 10;
  index := index - 1;
UNTIL index = 0;
zfill4 := result;
END;
{%include 'paslibdsk:[paslib]zint.inc'}
 FUNCTION zint(num : string) : INTEGER;
 VAR iwork : INTEGER;
     val,pow : INTEGER;
 BEGIN
 val := 0;
 pow := 1;
 iwork := LENGTH(num);
 WHILE iwork > 0 DO
      BEGIN
      val := val + pow * (ORD(num[iwork]) - ORD('0'));
      iwork := iwork - 1;
      pow := pow * 10;
      END;
 zint := val;
 END;
{%include 'interfacdsk:[interfac.screen]scrutil.inc'}
{PROGRAM WRITTEN BY DON KOOKER FOR ABIM}

[EXTERNAL] PROCEDURE lib$wait(t : REAL); EXTERN;

PROCEDURE SS$_ERROR (CODE:INTEGER);
BEGIN
WRITELN (OUTPUT, 'SS$_ERROR: ', CODE)
END;

PROCEDURE INIT_CHAR;
{ initialize char io channel and buffer }
VAR ICODE: INTEGER;
BEGIN
WRITE_BUF_LEN := 0;
ICODE := $ASSIGN ('TT', CHANNEL);
IF NOT ODD (ICODE) THEN SS$_ERROR (ICODE)
END;

PROCEDURE PUT_LINE;
{ force the char io buffer}
VAR ICODE: INTEGER;
BEGIN
IF WRITE_BUF_LEN > 0
THEN BEGIN
     ICODE := $QIOW (, CHANNEL, IO$_WRITEVBLK, , , , WRITE_BUF, WRITE_BUF_LEN);
     WRITE_BUF_LEN := 0;
     IF NOT ODD (ICODE) 
     THEN SS$_ERROR (ICODE)
     END
END;

PROCEDURE PUT_CHAR(CH : CHAR);
BEGIN
WRITE_BUF_LEN := WRITE_BUF_LEN + 1;
WRITE_BUF[WRITE_BUF_LEN] := CH;
IF WRITE_BUF_LEN = 80 THEN PUT_LINE
END;

PROCEDURE PUT_STRING(out_text : string);
VAR I: INTEGER;
BEGIN
FOR I := 1 TO LENGTH(out_text) DO 
     BEGIN
     WRITE_BUF_LEN := WRITE_BUF_LEN + 1;
     WRITE_BUF[WRITE_BUF_LEN] := out_text[I];
     IF WRITE_BUF_LEN = 80 THEN PUT_LINE
     END;
END;

PROCEDURE minput_string(out_text : string);
VAR i,jwork,kwork : INTEGER;
    found : BOOLEAN;
BEGIN
jwork := LENGTH(out_text);
FOUND := FALSE;
WHILE (jwork > 1) AND (NOT found) DO
     IF out_text[jwork] = ' '
     THEN jwork := jwork - 1
     ELSE found := TRUE;
kwork := 1;
WHILE (kwork < jwork) AND (out_text[kwork] = ' ') DO
     kwork := kwork + 1;
FOR i := kwork TO jwork DO
   BEGIN
   WRITE_BUF_LEN := WRITE_BUF_LEN + 1;
   WRITE_BUF[WRITE_BUF_LEN] := out_text[I];
   IF WRITE_BUF_LEN = 80 THEN PUT_LINE
   END;
END;

FUNCTION get_char : CHAR;
VAR icode : INTEGER;
    read_buf : char_80;
BEGIN
put_line;
icode := $QIOW(, CHANNEL,
                 IO$_READVBLK + IO$M_TRMNOECHO + IO$M_NOECHO + IO$M_NOFILTR,
                 , , , READ_BUF, 1);
IF NOT ODD(icode)
THEN SS$_ERROR(icode)
ELSE get_char := read_buf[1]
END;

FUNCTION get_char_npl : CHAR;
VAR icode : INTEGER;
    read_buf : char_80;
BEGIN
icode := $QIOW(, CHANNEL,
                  IO$_READVBLK + IO$M_TRMNOECHO + IO$M_NOECHO + IO$M_NOFILTR,
                  , , , READ_BUF, 1);
IF NOT ODD(icode)
THEN SS$_ERROR(icode)
ELSE get_char_npl := read_buf[1]
END;

PROCEDURE POSITION(X,Y : INTEGER);
VAR CH : CHAR;
    VVAL : INTEGER;
BEGIN
PUT_CHAR(CHR(27));
PUT_CHAR('[');
IF Y > 9 
THEN BEGIN
     CH := CHR(ORD('0') + (Y DIV 10));
     Y := Y - ((Y DIV 10) * 10);
     PUT_CHAR(CH);
     END;
CH := CHR(ORD('0') + Y);
PUT_CHAR(CH);
PUT_CHAR(';');
IF X > 99
THEN BEGIN
     CH := CHR(ORD('0') + (X DIV 100));
     X := X - ((X DIV 100) * 100);
     PUT_CHAR(CH);

     CH := CHR(ORD('0') + (X DIV 10));
     X := X - ((X DIV 10) * 10);
     PUT_CHAR(CH);
     END
ELSE IF X > 9
     THEN BEGIN
          CH := CHR(ORD('0') + (X DIV 10));
          X := X - ((X DIV 10) * 10);
          PUT_CHAR(CH);
          END;

CH := CHR(ORD('0') + X);
PUT_CHAR(CH);
PUT_CHAR('H');
PUT_LINE;
END;

PROCEDURE clear_screen;
BEGIN
put_char(esc);
put_string('[2J');
put_line;
END;

PROCEDURE erase_line(y : INTEGER);
BEGIN
position(1,y);
put_char(esc);
put_string('[2K');
END;

PROCEDURE width_132;
BEGIN
put_char(esc);
put_string('[?3h');
END;

PROCEDURE width_80;
BEGIN
put_char(esc);
put_string('[?3l');
END;

PROCEDURE bold_rev_att_on;
BEGIN
put_char(esc);
put_string('[1;7m');
END;

PROCEDURE bold_att_on;
BEGIN
put_char(esc);
put_string('[1m');
END;

PROCEDURE rev_att_on;
BEGIN
put_char(esc);
put_string('[7m');
END;

PROCEDURE blink_att_on;
BEGIN
put_char(esc);
put_string('[5m');
END;

PROCEDURE under_att_on;
BEGIN
put_char(esc);
put_string('[4m');
END;

PROCEDURE att_off;
BEGIN
put_char(esc);
put_string('[0m');
END;

PROCEDURE draw_box(y1,x1,y2,x2 : INTEGER);
VAR iwork : INTEGER;
BEGIN
put_char(esc); {graphics on}
put_string('(0');
FOR iwork := y1+1 TO y2-1 DO {draw vertical lines}
   BEGIN
   position(x1,iwork);
   put_char('x');
   position(x2,iwork);
   put_char('x');
   END;
IF x1 < x2-1 
THEN BEGIN {draw horizontal lines}
     position(x1+1,y1);
     put_string(SUBSTR('qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq',
              1,x2-x1-1));
     position(x1+1,y2);
     put_string(SUBSTR('qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq',
              1,x2-x1-1));
     END;
position(x1,y1);  {draw corners}
put_char('l');
position(x2,y1);
put_char('k');
position(x1,y2);
put_char('m');
position(x2,y2);
put_char('j');
put_char(esc); {graphics off}
put_string('(B');
END;

PROCEDURE ring_bell;
BEGIN
put_char(CHR(7));
put_line;
END;

PROCEDURE display_record_field(input_line : string; 
   start_index,llen,x_pos,y_pos : INTEGER);
BEGIN
position(x_pos,y_pos);
under_att_on;
put_string(SUBSTR(input_line,start_index,llen));
att_off;
END;

PROCEDURE read_record_field_scroll(VAR input_line : 
    PACKED ARRAY [low..high:INTEGER] OF CHAR; ttype : CHAR; 
    start_index,llen,dlen,x_pos_start,y_pos,x_len : INTEGER; 
    VAR direction : INTEGER);

VAR in_char : CHAR;
    i,deci_found,cur_index,left_index,off_set,last_pt,last_in,iwork,sign_off
      : INTEGER;
    tmp_line : VARYING [255] OF CHAR;
    insert_mode,found : BOOLEAN;
BEGIN
position(x_pos_start,y_pos);
under_att_on;
cur_index := start_index;
left_index := start_index;
direction := 0;
insert_mode := TRUE;
deci_found := 0;
last_pt := start_index + llen - 1;
IF (ttype = 'A') OR (ttype = 'U')
THEN BEGIN
     last_in := last_pt;
     found := FALSE;
     WHILE (last_in >= start_index) AND (NOT found) DO
          IF (input_line[last_in] = ' ') 
          THEN last_in := last_in - 1
          ELSE found := TRUE;
     END
ELSE last_in := start_index - 1;
REPEAT
   in_char := get_char;
   CASE ORD(in_char) OF
      1: IF (ttype = 'A') OR (ttype = 'U')
         THEN insert_mode := NOT insert_mode
         ELSE ring_bell;
     12: IF (ttype = 'A') OR (ttype = 'U')
         THEN BEGIN
              cur_index := start_index;
              IF left_index <> start_index
              THEN BEGIN
                   position(x_pos_start,y_pos);
                   FOR i := start_index TO start_index + x_len - 1 DO
                      put_char(input_line[i]);
                   left_index := start_index;
                   END;
              position(x_pos_start,y_pos);
              END
         ELSE ring_bell;
     18: IF (ttype = 'A') OR (ttype = 'U')
         THEN BEGIN
              cur_index := last_in + 1;
              IF cur_index > (left_index + x_len - 1)
              THEN BEGIN
                   position(x_pos_start,y_pos);
                   left_index := cur_index - x_len + 1;
                   FOR i := left_index TO cur_index DO
                      put_char(input_line[i]);
                   END;
              position(x_pos_start + cur_index - left_index, y_pos);
              END
         ELSE ring_bell;
      2: IF (ttype = 'A') OR (ttype = 'U')
         THEN BEGIN
              FOR I := cur_index TO last_in DO
                  BEGIN
                  input_line[i] := ' ';
                  IF (i - left_index) < x_len
                  THEN put_char(' ');   
                  END;      
              position(x_pos_start + cur_index - left_index, y_pos);
              END
         ELSE ring_bell;  
     13: direction := 1; {move foward}
      8: direction := -1; {back space}
      9: direction := 9999; {jump out of the edit}
     27: BEGIN
         in_char := get_char;
         CASE ORD(in_char) OF 
           79:BEGIN {pf}
              in_char := get_char;
              CASE ORD(in_char) OF
                81:direction := 9996; {pf2 - help}
                83:direction := 9995; {pf4 - cancel/exit}
                OTHERWISE ring_bell;
                END;
              END;
           91:BEGIN {arrow}
              in_char := get_char;
              CASE ORD(in_char) OF
                65:direction := 9997; {up - page up}
                66:direction := 9998; {down - page down}
                68:IF (ttype = 'A') OR (ttype = 'U')
                   THEN BEGIN
                        IF cur_index > start_index
                        THEN BEGIN
                             cur_index := cur_index - 1;
                             IF cur_index < left_index
                             THEN BEGIN
                                  position(x_pos_start,y_pos);
                                  left_index := left_index - 1;
                                  FOR i := cur_index TO min(last_in,
                                     left_index + x_len - 1) DO
                                     put_char(input_line[i]);
                                  END;
                             position(x_pos_start + cur_index - left_index,
                                y_pos);
                             END
                        ELSE ring_bell;
                        END
                   ELSE ring_bell;
                67:IF (ttype = 'A') OR (ttype = 'U')
                   THEN IF cur_index <= last_pt
                        THEN BEGIN
                             IF cur_index > (left_index + x_len - 1)
                             THEN BEGIN
                                  position(x_pos_start,y_pos);
                                  left_index := left_index + 1;
                                  FOR i := left_index TO min(last_in + 1,
                                      left_index + x_len - 1) DO
                                     put_char(input_line[i]);
                                  END;
                             cur_index := cur_index + 1;
                             position(x_pos_start + cur_index - left_index,
                                y_pos);
                             END
                        ELSE ring_bell
                   ELSE ring_bell; 
               OTHERWISE ring_bell;
                END;
              END;
           OTHERWISE ring_bell;
           END;
         END; 
      4: BEGIN {delete}
         IF (ttype = 'A') OR (ttype = 'U')
         THEN BEGIN
              FOR i := cur_index + 1 TO last_in DO
                   input_line[i - 1] := input_line[i];
              IF last_in >= start_index
              THEN input_line[last_in] := ' ';
              FOR i := cur_index TO min(last_in,
                   left_index + x_len - 1) DO
                  put_char(input_line[i]);
              IF last_in >= cur_index
              THEN last_in := last_in - 1;
              position(x_pos_start + cur_index - left_index, y_pos);
              END
          ELSE ring_bell; {back up past start}
          END;
    127: BEGIN {delete}
         IF cur_index > start_index
         THEN IF (ttype = 'A') OR (ttype = 'U')
              THEN BEGIN
                   FOR i := cur_index TO last_in DO
                        input_line[i - 1] := input_line[i];
                   IF last_in >= start_index
                   THEN input_line[last_in] := ' ';
                   cur_index := cur_index - 1;
                   IF cur_index < left_index
                   THEN left_index := left_index - 1;
                   position(x_pos_start + cur_index - left_index, y_pos);
                   FOR i := cur_index TO min(last_in,left_index + x_len - 1) DO
                        put_char(input_line[i]);
                   position(x_pos_start + cur_index - left_index, y_pos);
                   IF last_in >= cur_index 
                   THEN last_in := last_in - 1;
                   END  
              ELSE BEGIN
                   cur_index := cur_index - 1;
                   IF input_line[cur_index] = '.'
                   THEN deci_found := 0;
                   input_line[cur_index] := ' ';

                   IF cur_index < left_index
                   THEN BEGIN
                        position(x_pos_start,y_pos);
                        left_index := left_index - 1;
                        FOR i := cur_index TO min(last_in,
                            left_index + x_len - 1) DO
                           put_char(input_line[i]);
                        END
                   ELSE BEGIN
                        position(x_pos_start + cur_index - left_index, y_pos);
                        put_char(' ');
                        END;
                   position(x_pos_start + cur_index - left_index, y_pos);
                   IF last_in >= cur_index 
                   THEN last_in := last_in - 1;
                   END
          ELSE ring_bell; {back up past start}
          END; 
      OTHERWISE
          IF cur_index = start_index + llen  {exceed field length}
          THEN ring_bell
          ELSE BEGIN 
               IF ((ttype IN ['I','Z']) AND ((in_char IN ['0'..'9']) OR
                             ((in_char = '-') AND (cur_index = start_index))))
                               OR
                 ((ttype IN ['F']) AND ((in_char IN ['0'..'9']) OR
                             ((in_char = '.') AND (deci_found = 0)) OR
                             ((in_char = '-') AND (cur_index=start_index))))
                               OR
                 ((ttype IN ['A','U']) AND (ORD(in_char) > 31) AND 
                             (ORD(in_char) < 127))
               THEN BEGIN
                    IF ((ttype = 'A') OR (TTYPE = 'U')) AND (INSERT_MODE)
                    THEN BEGIN
                         IF last_in < cur_index
                         THEN last_in := cur_index
                         ELSE IF last_in < last_pt
                              THEN last_in := last_in + 1;
                         FOR i := last_in DOWNTO cur_index + 1 DO
                              input_line[i] := input_line[i - 1];
                         input_line[cur_index] := in_char;
                         IF cur_index > (left_index + x_len - 1)
                         THEN BEGIN
                              position(x_pos_start,y_pos);
                              left_index := left_index + 1;
                              FOR i := left_index TO min(last_in,
                                  left_index + x_len - 1) DO
                                 put_char(input_line[i]);
                              END
                         ELSE BEGIN
                              FOR i := cur_index TO min(last_in,
                                  left_index + x_len - 1) DO
                                   put_char(input_line[i]);
                              END;
                         cur_index := cur_index + 1;
                         position(x_pos_start + cur_index - left_index, y_pos);
                         END
                    ELSE BEGIN
                         IF last_in < cur_index
                         THEN last_in := cur_index;
                         input_line[cur_index] := in_char;
                         IF cur_index > (left_index + x_len - 1)
                         THEN BEGIN
                              position(x_pos_start,y_pos);
                              left_index := left_index + 1;
                              FOR i := left_index TO min(last_in,
                                  left_index + x_len - 1) DO
                                 put_char(input_line[i]);
                              END
                         ELSE put_char(in_char);

                         IF in_char = '.' 
                         THEN deci_found := cur_index;
                         cur_index := cur_index + 1;
                         END;
                    END
               ELSE ring_bell; {illegal character}
               END;
     END; {case}
UNTIL (direction <> 0);
IF cur_index > start_index
THEN BEGIN
     IF ttype = 'U'
     THEN BEGIN
          FOR iwork := start_index TO last_in DO
              IF input_line[iwork] IN ['a'..'z']
              THEN input_line[iwork] := CHR(ORD(input_line[iwork])-ORD('a')+ORD('A'));
          END;
     IF ttype = 'I'
     THEN BEGIN
          off_set := last_pt - last_in;
          FOR iwork := last_in DOWNTO start_index DO
             input_line[iwork + off_set] := input_line[iwork];
          FOR iwork := start_index TO start_index + off_set - 1 DO
             input_line[iwork] := ' ';
          END;
     IF ttype = 'Z'
     THEN BEGIN
          IF input_line[start_index] = '-'
          THEN sign_off := 1
          ELSE sign_off := 0;
          off_set := last_pt - last_in;
          FOR iwork := last_in DOWNTO start_index + sign_off DO
             input_line[iwork + off_set] := input_line[iwork];
          FOR iwork := start_index + sign_off TO 
                       start_index + sign_off + off_set - 1 DO
             input_line[iwork] := '0';
          END;
     IF ttype = 'F'
     THEN BEGIN
          tmp_line := '';
          IF deci_found = 0
          THEN deci_found := cur_index;
          FOR iwork := deci_found - 1 DOWNTO start_index DO
             IF deci_found - iwork < llen - dlen
             THEN tmp_line := input_line[iwork] + tmp_line;
          tmp_line := tmp_line + '.';
          FOR iwork := deci_found + 1 TO deci_found + dlen DO
             IF iwork < cur_index
             THEN tmp_line := tmp_line + input_line[iwork]
             ELSE tmp_line := tmp_line + '0';
          IF (tmp_line[1] = '.') AND (LENGTH(tmp_line) < llen)
          THEN tmp_line := '0' + tmp_line;
          WHILE LENGTH(tmp_line) < llen DO
             tmp_line := ' ' + tmp_line;
          FOR iwork := 1 TO llen DO
             input_line[start_index + iwork - 1] := tmp_line[iwork];
          END;
     END;
display_record_field(input_line,start_index,x_len,x_pos_start,y_pos);
END;

PROCEDURE read_record_field(VAR input_line : PACKED ARRAY [low..high:INTEGER] 
                            OF CHAR; ttype : CHAR; 
                            start_index,llen,dlen,x_pos,y_pos : INTEGER; 
                            VAR direction : INTEGER);
VAR in_char : CHAR;
    I,deci_found,cur_index,off_set,last_pt,in_len,iwork,sign_off : INTEGER;
    tmp_line : VARYING [255] OF CHAR;
    insert_mode : BOOLEAN;
BEGIN
read_record_field_scroll(input_line,ttype,start_index,llen,dlen,x_pos,y_pos,
  llen,direction);
END;


PROCEDURE graph_on;
BEGIN
put_char(esc);
put_string('(0');
END;

PROCEDURE graph_off;
BEGIN
put_char(esc);
put_string('(B');
END;

PROCEDURE display_map;
VAR x,y : INTEGER;

   PROCEDURE display_sector(x_sector,y_sector : INTEGER);
   BEGIN
   IF sector[x,y].base
   THEN put_char('B')
   ELSE put_char(' ');
   IF sector[x,y].probe
   THEN put_char('P')
   ELSE put_char(' ');
   IF (star_ship.sector.x = x) AND
      (star_ship.sector.y = y)
   THEN put_char('E')
   ELSE put_char(' ');
   END;

BEGIN
graph_on;
position(1,1);
put_string('lFqEqDqEqRqAqTqIqOqNqqqTqEqRqRqIqTqOqRqYqqqqqqqk  ');
FOR y := 1 TO 7 DO
   BEGIN
   position(1,y+1);
   put_char('x');
   FOR x := 1 TO 7 DO
      display_sector(x,y);
   put_char(' ');
   FOR x := 8 TO 15 DO
     display_sector(x,y);
   put_char('x');
   put_string(zfill2(y));
   END;
position(1,9);
put_string('tqqqqqqNqEqUqTqRqAqLqqwqqqqZqOqNqEqqqqqqqqqqqqqu  ');
FOR y := 8 TO 15 DO
   BEGIN
   position(1,y+2);
   put_char('x');
   FOR x := 1 TO 7 DO
      display_sector(x,y);
   put_char('x');
   FOR x := 8 TO 15 DO
      display_sector(x,y);
   put_char('x');
   put_string(zfill2(y));
   END;   
position(1,18);
put_string('mqROMULANqTERRITORYqqqvqqqqqqKLINGONqTERRITORYqj  ');
position(1,19);
put_char(' ');
FOR x := 1 TO 7 DO
   BEGIN
   put_string(zfill2(x));
   put_char(' ');
   END;
put_char(' ');
FOR x := 8 TO 15 DO
   BEGIN
   put_string(zfill2(x));
   put_char(' ');
   END;
put_string('  ');
graph_off;
END;

PROCEDURE alert_message(s : string);
BEGIN
alert_mess[20] := alert_mess[21];
position(1,20);
put_string(pad(alert_mess[20],' ',50));

alert_mess[21] := alert_mess[22];
position(1,21);
put_string(pad(alert_mess[21],' ',50));

alert_mess[22] := s;
position(1,22);
put_string(pad(alert_mess[22],' ',50));
END;

FUNCTION random(up_bound : INTEGER) : INTEGER;
{randomly pick a number between 1 AND up_bound}
VAR vvalue : INTEGER;
    tstr : char_11;
BEGIN
TIME(tstr);
vvalue := (rseed MOD up_bound) + 1;
rseed := rseed + up_bound * zint(substr(tstr,7,2)) MOD (zint(substr(tstr,10,2)) + 1);
IF rseed > 10000
THEN rseed := rseed DIV (zint(substr(tstr,10,2)) + 1);
random := vvalue;
END;

PROCEDURE term_game(mess_no : INTEGER);
BEGIN
CASE mess_no OF
   1:alert_message('YOU HAVE LEFT THE GALAXY AND ARE LOST IN SPACE');
   2:alert_message('YOU HAVE BEEN DESTROYED');
   3:alert_message('CONGRADULATIONS: YOU HAVE WON THE GAME');
   4:alert_message('YOu ARE POWERLESS IN SPACE');
   END;
put_line;
lib$wait(15.0);
HALT;
END;

PROCEDURE display_condition;
BEGIN
position(53,1);
bold_rev_att_on;
put_string('CONDITION: ');
IF star_ship.alert_cnt <> 0
THEN BEGIN
     blink_att_on;
     put_string('RED         ');
     END
ELSE IF (star_ship.fuel + star_ship.shields) < 500
     THEN put_string('YELLOW      ')
     ELSE put_string('GREEN       ');
att_off;

position(53,2);
put_string('                       ');

position(53,3);
put_string('Sector (');
put_string(zfill2(star_ship.sector.x));
put_char(',');
put_string(zfill2(star_ship.sector.y));
put_string(')         ');

position(53,4);
put_string('Location (');
put_string(zfill2(star_ship.location.x));
put_char(',');
put_string(zfill2(star_ship.location.y));
put_string(')       ');

position(53,5);
put_string('                       ');

position(53,6);
put_string('Fuel: ');
put_string(zfill4(star_ship.fuel));
put_string('             ');

position(53,7);
put_string('Shields: ');
put_string(zfill4(star_ship.shields));
put_string('          ');

position(53,8);
put_string('Probes: ');
put_string(zfill2(star_ship.probe_cnt));
put_string('             ');

position(53,9);
put_string('Photons: ');
put_string(zfill2(star_ship.photon_cnt));
put_string('            ');

position(53,10);
put_string('                       ');
END;

PROCEDURE do_repair;
VAR start_item,item : INTEGER;
    found : BOOLEAN;
BEGIN
start_item := RANDOM(9);
item := start_item;
found := FALSE;
REPEAT
   IF star_ship.damage[item] < 0
   THEN found := TRUE
   ELSE BEGIN
        item := item + 1;
        IF item > 9
        THEN item := 1;
        END;
UNTIL found OR (item = start_item);

star_ship.damage[item] := star_ship.damage[item] + 1;
IF (star_ship.damage[item] = 0) AND (star_ship.damage[1] >= 0)
THEN CASE item OF
       1 : alert_message('Damage control now functional');
       2 : alert_message('Phasors are repaired');
       3 : alert_message('Photon control has been restored');
       4 : alert_message('Shield control now operational');
       5 : alert_message('Long range scanners have been repaired');
       6 : alert_message('Short range sensors operational');
       7 : alert_message('Auxiliary drive has been restored');
       8 : alert_message('Warp drive engines have been repaired');
       9 : alert_message('Communications systems have been restored');
         END;
END;

PROCEDURE record_enemy_hit(power : INTEGER);
VAR damage_index,damage_amount : INTEGER;
BEGIN
star_ship.shields := star_ship.shields - power;
alert_message('Enterprise hit ('+zfill4(power)+' units) ! ! !');
IF star_ship.shields < 0
THEN term_game(2);
damage_index := RANDOM(9);
damage_amount := RANDOM(5 - skill_level DIV 25);
star_ship.damage[damage_index] := star_ship.damage[damage_index] - 
   damage_amount;
IF (star_ship.damage[damage_index] < 0) AND 
   ((star_ship.damage[damage_index] + damage_amount) >= 0) AND
   ((star_ship.damage[1] >= 0) OR (damage_index = 1))
THEN BEGIN
     CASE damage_index OF
       1 : alert_message('Damage control disabled');
       2 : alert_message('Phasor control not functioning');
       3 : alert_message('Photon control has been lost');
       4 : alert_message('Shield control not operational');
       5 : alert_message('Long range scanners have been damaged');
       6 : alert_message('Short range sensors have been lost');
       7 : alert_message('Auxiliary engines damaged');
       8 : alert_message('Warp drive engines have been disabled');
       9 : alert_message('Communications systems have been lost');
         END;
     END;
IF (star_ship.damage[damage_index] < 0) AND 
   ((star_ship.damage[damage_index] + damage_amount) >= 0) AND
   (damage_index = 6)
THEN BEGIN
     display_map;
     sr_scan_on := FALSE;
     END;
display_condition;
END;

PROCEDURE fire_back(sx,sy,ex,ey : INTEGER; VAR hit : BOOLEAN);
VAR dx,dy : INTEGER;
    rad,t : REAL;
    dist,x,y : INTEGER;
    collision,new_sector : BOOLEAN;
BEGIN
dx := ex - sx;
dy := ey - sy;
IF dx = 0
THEN IF dy < 0
     THEN rad := 270 * 0.01746032
     ELSE rad :=  90 * 0.01746032
ELSE BEGIN
     t := ARCTAN(ABS(dy) /ABS(dx));
     IF dx > 0 
     THEN IF dy > 0
          THEN rad := t 
          ELSE rad := 360 * 0.01746032 - t
     ELSE IF dy > 0
          THEN rad := 180 * 0.01746032 - t
          ELSE rad := 180 * 0.01746032 + t;     
     END;
dist := 1;
collision := FALSE;
new_sector := FALSE;
hit := FALSE;
WHILE (NOT collision) AND (NOT new_sector) DO
     BEGIN
     x := sx + ROUND(dist * cos(rad));
     y := sy + ROUND(dist * sin(rad));
     IF (x < 1) OR (x > 15) OR (y < 1) OR (y > 15)
     THEN new_sector := TRUE
     ELSE IF location[x,y] <> '   '
          THEN BEGIN
               collision := TRUE;
               IF location[x,y] = star_ship_char
               THEN hit := TRUE;
               END
          ELSE BEGIN
               IF sr_scan_on
               THEN BEGIN
                    position(x*3,y+1);
                    put_char('*');
                    position(x*3,y+1);
                    put_line;
                    lib$wait(0.015);
                    put_char(' ');
                    END;
               dist := dist + 1;
               END;
     END;
END;

PROCEDURE attack_object(object : string; x_offset,sector_x,sector_y : INTEGER);
VAR x,y : INTEGER;
BEGIN
IF RANDOM(3 + skill_level DIV 20) = 1
THEN BEGIN
     IF star_ship.damage[9] >= 0
     THEN alert_message(object + ' at (' + zfill2(sector_x) + ',' +
            zfill2(sector_y) + ') has been destroyed');
     IF x_offset = 1
     THEN sector[sector_x,sector_y].probe := FALSE
     ELSE sector[sector_x,sector_y].base := FALSE;
     IF NOT sr_scan_on
     THEN BEGIN
          IF sector_x < 8
          THEN x := sector_x * 3 + x_offset - 1
          ELSE x := sector_x * 3 + x_offset;
          IF sector_y < 8
          THEN y := sector_y + 1
          ELSE y := sector_y + 2;
          position(x,y);
          put_char(' ');
          END;
     END
ELSE BEGIN
     IF star_ship.damage[9] >= 0
     THEN alert_message(object + ' at (' + zfill2(sector_x) + ',' +
             zfill2(sector_y) + ') under attack');
     END;
END;

PROCEDURE do_klingon_action;
VAR iwork,next_klingon,last_klingon : INTEGER;
    done : BOOLEAN;
    hit : BOOLEAN;
    power : INTEGER;

    PROCEDURE move_klingon_sector(number,sector_x,sector_y : INTEGER);
    BEGIN 
    IF (klingon[number].sector.x = star_ship.sector.x) AND
       (klingon[number].sector.y = star_ship.sector.y)
    THEN BEGIN 
         star_ship.alert_cnt := star_ship.alert_cnt - 1;
         display_condition;
         location[klingon[number].location.x,
                  klingon[number].location.y] := '   ';
         IF sr_scan_on
         THEN BEGIN
              position(klingon[number].location.x*3-1,
                       klingon[number].location.y+1);
              put_string('   ');
              END;
         END;
    klingon[number].strength := 
       MAX(750,
           klingon[number].strength - 
              (ABS(sector_x - klingon[number].sector.x) +
               ABS(sector_y - klingon[number].sector.y)) * 100);
    klingon[number].sector.x := sector_x;
    klingon[number].sector.y := sector_y;
    klingon[number].hit := 0;
    klingon[number].miss := FALSE;
    IF (klingon[number].sector.x = star_ship.sector.x) AND
       (klingon[number].sector.y = star_ship.sector.y)
    THEN BEGIN
         star_ship.alert_cnt := star_ship.alert_cnt + 1;
         display_condition;
         WHILE location[klingon[number].location.x,
                        klingon[number].location.y] <> '   ' DO
              BEGIN
              klingon[number].location.x := RANDOM(15);
              klingon[number].location.y := RANDOM(15);
              END;
        location[klingon[number].location.x,
                 klingon[number].location.y] := klingon_char;
        IF sr_scan_on
        THEN BEGIN
             position(klingon[number].location.x*3-1,
                      klingon[number].location.y+1);
             put_string(klingon_char);
             END;
        END;
    IF sector[klingon[number].sector.x,klingon[number].sector.y].probe AND
       (star_ship.damage[9] >= 0)
    THEN alert_message('Probe in sector (' + zfill2(klingon[number].sector.x) +
            ',' + zfill2(klingon[number].sector.y) + ') reports motion');
    IF sector[klingon[number].sector.x,klingon[number].sector.y].base AND
       (star_ship.damage[9] >= 0)
    THEN alert_message('Base in sector (' + zfill2(klingon[number].sector.x) +
            ',' + zfill2(klingon[number].sector.y) + ') reports motion');
    END;


BEGIN
done := FALSE;
iwork := 1;
WHILE (iwork <= 5) AND (NOT done) DO
     BEGIN
     IF (klingon[iwork].sector.x = star_ship.sector.x) AND
        (klingon[iwork].sector.y = star_ship.sector.y)
     THEN BEGIN
          IF (klingon[iwork].hit > 2) OR {HIT MORE THAN TWICE, MOVE LOCATION}
              klingon[iwork].miss
          THEN BEGIN
               location[klingon[iwork].location.x,
                        klingon[iwork].location.y] := '   ';
               IF sr_scan_on
               THEN BEGIN
                    position(klingon[iwork].location.x*3-1,
                             klingon[iwork].location.y+1);
                    put_string('   ');
                    END;
               REPEAT 
                  klingon[iwork].location.x := RANDOM(15);
                  klingon[iwork].location.y := RANDOM(15);
               UNTIL location[klingon[iwork].location.x,
                              klingon[iwork].location.y] = '   ';
               klingon[iwork].hit := 0;
               klingon[iwork].miss := FALSE;
               location[klingon[iwork].location.x,
                        klingon[iwork].location.y] := klingon_char;
               IF sr_scan_on
               THEN BEGIN
                    position(klingon[iwork].location.x*3-1,
                             klingon[iwork].location.y+1);
                    put_string(klingon_char);
                    END;
               done := TRUE;
               END;
          END;
     iwork := iwork + 1;
     END;
iwork := RANDOM(5);
last_klingon := iwork;
IF NOT done
THEN BEGIN
     REPEAT
        IF (klingon[iwork].sector.x = star_ship.sector.x) AND
           (klingon[iwork].sector.y = star_ship.sector.y)
        THEN BEGIN
             next_klingon := RANDOM(5);
             IF (NOT ((klingon[next_klingon].sector.x = star_ship.sector.x) AND
                      (klingon[next_klingon].sector.y = star_ship.sector.y))) AND 
                (klingon[next_klingon].sector.x > 0) AND 
                (klingon[next_klingon].strength > (2000 + skill_level * 20))
             THEN move_klingon_sector(next_klingon,klingon[iwork].sector.x,
                      klingon[iwork].sector.y)
             ELSE BEGIN
                   fire_back(klingon[iwork].location.x,klingon[iwork].location.y,
                     star_ship.location.x,star_ship.location.y,hit);
                  IF hit AND (klingon[iwork].strength > 0)
                  THEN BEGIN
                       power := MAX(80,MIN(1000,RANDOM(klingon[iwork].strength DIV 
                         (1 + skill_level DIV 5))));
                       klingon[iwork].strength := klingon[iwork].strength - 
                           power;
                       record_enemy_hit(power);
                       END
                  ELSE klingon[iwork].miss := NOT hit;
                  END;
             done := TRUE;
             END
        ELSE BEGIN
             iwork := iwork + 1;
             IF iwork > 5
             THEN iwork := 1;
             END;
     UNTIL done OR (iwork = last_klingon);
     END;
IF NOT done {no battle going on, pick random klingon and move}
THEN BEGIN
     iwork := RANDOM(5);
     IF klingon[iwork].sector.x > 0
     THEN BEGIN
          IF klingon[iwork].strength < (1500 - skill_level * 10) {go home and refuel if needed}
          THEN BEGIN
               move_klingon_sector(iwork,RANDOM(7) + 8,RANDOM(7) + 8);
               klingon[iwork].strength := 5000;
               END
          ELSE BEGIN 
               IF sector[klingon[iwork].sector.x,klingon[iwork].sector.y].probe
               THEN attack_object('Probe',1,klingon[iwork].sector.x,
                         klingon[iwork].sector.y)
               ELSE BEGIN
                    IF sector[klingon[iwork].sector.x,
                              klingon[iwork].sector.y].base
                    THEN attack_object('Base',0,klingon[iwork].sector.x,
                           klingon[iwork].sector.y)
                    ELSE move_klingon_sector(iwork,RANDOM(15),RANDOM(7));
                    END;
               END;
          END;
     END;
END;

PROCEDURE do_romulan_action;
VAR iwork,last_romulan : INTEGER;
    done : BOOLEAN;
    hit : BOOLEAN;
    power : INTEGER;

    PROCEDURE move_romulan_sector(number : INTEGER);
    VAR sector_x,sector_y : INTEGER;
    BEGIN 
    IF (romulan[number].target_sector.x = romulan[number].sector.x) AND
       (romulan[number].target_sector.y = romulan[number].sector.y)
    THEN BEGIN
         IF (romulan[number].sector.y > 7) AND (romulan[number].sector.x < 8)
         THEN romulan[number].strength := 10000;
         romulan[number].target_sector.x := RANDOM(15);
         romulan[number].target_sector.y := RANDOM(15);
         END;

    IF romulan[number].target_sector.x > romulan[number].sector.x
    THEN sector_x := romulan[number].sector.x + 1
    ELSE IF romulan[number].target_sector.x < romulan[number].sector.x
         THEN sector_x := romulan[number].sector.x - 1
         ELSE sector_x := romulan[number].sector.x;
    IF romulan[number].target_sector.y > romulan[number].sector.y
    THEN sector_y := romulan[number].sector.y + 1
    ELSE IF romulan[number].target_sector.y < romulan[number].sector.y
         THEN sector_y := romulan[number].sector.y - 1
         ELSE sector_y := romulan[number].sector.y;

    IF (romulan[number].sector.x = star_ship.sector.x) AND
       (romulan[number].sector.y = star_ship.sector.y)
    THEN BEGIN
         IF romulan[number].cloak
         THEN star_ship.cloak_alert_cnt := star_ship.cloak_alert_cnt - 1
         ELSE star_ship.alert_cnt := star_ship.alert_cnt - 1;
         display_condition;
         location[romulan[number].location.x,
                  romulan[number].location.y] := '   ';
         IF sr_scan_on
         THEN BEGIN
              position(romulan[number].location.x*3-1,
                       romulan[number].location.y+1);
              put_string('   ');
              END;
         END;
    romulan[number].strength := 
       MAX(750,
           romulan[number].strength - 
              (ABS(sector_x - romulan[number].sector.x) +
               ABS(sector_y - romulan[number].sector.y)) * 100);
    romulan[number].sector.x := sector_x;
    romulan[number].sector.y := sector_y;
    romulan[number].hit := FALSE;
    romulan[number].miss := FALSE;
    IF (romulan[number].sector.x = star_ship.sector.x) AND
       (romulan[number].sector.y = star_ship.sector.y)
    THEN BEGIN
         IF romulan[number].cloak
         THEN star_ship.cloak_alert_cnt := star_ship.cloak_alert_cnt + 1
         ELSE star_ship.alert_cnt := star_ship.alert_cnt + 1;
         display_condition;
         WHILE location[romulan[number].location.x,
                        romulan[number].location.y] <> '   ' DO
              BEGIN
              romulan[number].location.x := RANDOM(15);
              romulan[number].location.y := RANDOM(15);
              END;
        IF romulan[number].cloak
        THEN location[romulan[number].location.x,
                 romulan[number].location.y] := romulan_cloak_char
        ELSE BEGIN
             location[romulan[number].location.x,
                 romulan[number].location.y] := romulan_char;
             IF sr_scan_on
             THEN BEGIN
                  position(romulan[number].location.x*3-1,
                           romulan[number].location.y+1);
                  put_string(romulan_char);
                  END;
             end;
        END;
    IF sector[romulan[number].sector.x,romulan[number].sector.y].probe AND
       (star_ship.damage[9] >= 0)
    THEN alert_message('Probe in sector (' + zfill2(romulan[number].sector.x) +
            ',' + zfill2(romulan[number].sector.y) + ') reports motion');
    IF sector[romulan[number].sector.x,romulan[number].sector.y].base AND
       (star_ship.damage[9] >= 0)
    THEN alert_message('Base in sector (' + zfill2(romulan[number].sector.x) +
            ',' + zfill2(romulan[number].sector.y) + ') reports motion');
    END;

    PROCEDURE target_and_move(iwork : INTEGER);
    BEGIN
    romulan[iwork].target_sector.x := RANDOM(7) + 8;
    romulan[iwork].target_sector.y := RANDOM(7) + 8;
    move_romulan_sector(iwork);
    END;

BEGIN
done := FALSE;
iwork := 1;
WHILE (iwork <= 5) AND (NOT done) DO
     BEGIN
     IF (romulan[iwork].sector.x = star_ship.sector.x) AND
        (romulan[iwork].sector.y = star_ship.sector.y)
     THEN BEGIN
          IF romulan[iwork].strength < (2000 - skill_level * 10)
          THEN BEGIN
               target_and_move(iwork);
               done := TRUE;
               END
          ELSE BEGIN
               IF romulan[iwork].hit OR 
                  romulan[iwork].miss
               THEN BEGIN
                    location[romulan[iwork].location.x,
                             romulan[iwork].location.y] := '   ';
                    IF sr_scan_on
                    THEN BEGIN
                         position(romulan[iwork].location.x*3-1,
                                  romulan[iwork].location.y+1);
                         put_string('   ');
                         END;
                    REPEAT 
                       romulan[iwork].location.x := RANDOM(15);
                       romulan[iwork].location.y := RANDOM(15);
                    UNTIL location[romulan[iwork].location.x,
                                   romulan[iwork].location.y] = '   ';
                    romulan[iwork].hit := FALSE;
                    romulan[iwork].miss := FALSE;
                    IF NOT romulan[iwork].cloak
                    THEN BEGIN
                         romulan[iwork].cloak := TRUE;
                         star_ship.alert_cnt := star_ship.alert_cnt - 1;
                         star_ship.cloak_alert_cnt := 
                             star_ship.cloak_alert_cnt + 1;
                         display_condition;
                         END;
                    location[romulan[iwork].location.x,
                             romulan[iwork].location.y] := romulan_cloak_char;
                    done := TRUE;
                    END;
               END;
          END;
     iwork := iwork + 1;
     END;
IF NOT done
THEN BEGIN
     iwork := RANDOM(5);
     last_romulan := iwork;
     REPEAT
        IF (romulan[iwork].sector.x = star_ship.sector.x) AND
           (romulan[iwork].sector.y = star_ship.sector.y)
        THEN BEGIN
             IF romulan[iwork].cloak
             THEN BEGIN
                  star_ship.alert_cnt := star_ship.alert_cnt + 1;
                  star_ship.cloak_alert_cnt := star_ship.cloak_alert_cnt - 1;
                  display_condition;
                  romulan[iwork].cloak := FALSE;
                  location[romulan[iwork].location.x,
                           romulan[iwork].location.y] := romulan_char;
                  IF sr_scan_on
                  THEN BEGIN
                       position(romulan[iwork].location.x*3-1,
                                romulan[iwork].location.y+1);
                       put_string(romulan_char);
                       END;
                  END;
             fire_back(romulan[iwork].location.x,romulan[iwork].location.y,
                  star_ship.location.x,star_ship.location.y,hit);
             IF hit AND (romulan[iwork].strength > 0)
             THEN BEGIN
                  power := MAX(100,MIN(1500,RANDOM(romulan[iwork].strength DIV 
                     (1 + skill_level DIV 5))));
                  romulan[iwork].strength := romulan[iwork].strength - 
                      power;
                  record_enemy_hit(power);
                  END
             ELSE romulan[iwork].miss := NOT hit;
             done := TRUE;
             END
        ELSE BEGIN
             iwork := iwork + 1;
             IF iwork > 5
             THEN iwork := 1;
             END;
     UNTIL done OR (iwork = last_romulan);
     END;
IF NOT done 
THEN BEGIN
     iwork := RANDOM(5);
     IF romulan[iwork].sector.x > 0
     THEN BEGIN
          IF romulan[iwork].strength < (2500 - skill_level * 10) {go home and refuel if needed}
          THEN target_and_move(iwork)
          ELSE BEGIN 
               IF sector[romulan[iwork].sector.x,romulan[iwork].sector.y].probe
               THEN attack_object('Probe',1,romulan[iwork].sector.x,
                         romulan[iwork].sector.y)
               ELSE BEGIN
                    IF sector[romulan[iwork].sector.x,
                              romulan[iwork].sector.y].base
                    THEN attack_object('Base',0,romulan[iwork].sector.x,
                           romulan[iwork].sector.y)
                    ELSE move_romulan_sector(iwork);
                    END;
               END;
          END;
     END;
END;

PROCEDURE simulate_action;
VAR action : INTEGER;
BEGIN
action := RANDOM(11 - skill_level DIV 15);
CASE action OF 
             1 : do_repair;
    2,4,6,8,10 : do_klingon_action;
    3,5,7,9,11 : do_romulan_action;
         END;
END;

FUNCTION get_char_wait : CHAR;
VAR icode : INTEGER;
    read_buf : char_80;
    wait_time : INTEGER;
    sim_done : BOOLEAN;    
BEGIN
sim_done := FALSE;
REPEAT
   IF (NOT sim_done) AND (random(3 + skill_level DIV 25) = 1)
   THEN simulate_action;
   wait_time := RANDOM(5 + skill_level DIV 8);
   read_buf[1] := ' ';
   position(1,23);
   put_line;
   sim_done := FALSE;
   icode := $QIOW(, CHANNEL,
                 IO$_READVBLK + IO$M_TRMNOECHO + IO$M_NOECHO + IO$M_NOFILTR +
                 IO$M_TIMED,
                 , , , READ_BUF, 1, wait_time);
   IF read_buf[1] = ' '
   THEN BEGIN
        simulate_action;
        sim_done := TRUE;
        END;
UNTIL read_buf[1] <> ' ';
get_char_wait := read_buf[1]
END;

PROCEDURE read_number(x,y : INTEGER; VAR number : INTEGER);
VAR achar : char;
    sign : BOOLEAN;
    s_cnt : INTEGER;    
BEGIN
sign := FALSE;
s_cnt := 0;
number := 0;
position(x,y);
REPEAT
   achar := get_char_wait;
   position(x+s_cnt,y);
   IF (achar IN ['0'..'9'])
   THEN BEGIN
        put_char(achar);
        number := number * 10 + ORD(achar) - ORD('0');
        s_cnt := s_cnt + 1;
        END
   ELSE IF (achar = '-') AND (s_cnt = 0)
   THEN BEGIN
        sign := TRUE;
        put_char(achar);
        s_cnt := s_cnt + 1;
        END
   ELSE IF (achar = CHR(127)) AND (s_cnt > 0)
   THEN BEGIN
        put_char(chr(8));
        put_char(' ');
        put_char(chr(8));
        IF (s_cnt = 1) AND sign
        THEN sign := FALSE
        ELSE number := number DIV 10;
        s_cnt := s_cnt - 1;
        END
   ELSE IF (achar <> CHR(13))
   THEN ring_bell;
UNTIL achar = CHR(13);
IF sign
THEN number := 0 - number;
END;

PROCEDURE display_location;
VAR x,y : INTEGER;

BEGIN
IF star_ship.damage[6] < 0
THEN display_map
ELSE BEGIN
     graph_on;
     position(1,1);
     put_string('lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk    ');
     FOR y := 1 TO 15 DO
        BEGIN
        position(1,y+1);
        put_char('x');
        FOR x := 1 TO 15 DO
           put_string(location[x,y]);
        put_char('x');
        put_string(zfill2(y));
        put_char(' ');
        END;
     position(1,17);
     put_string('mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj   ');
     position(1,18);
     put_char(' ');
     FOR x := 1 TO 15 DO
        BEGIN
        put_string(zfill2(x));
        put_char(' ');
        END;
     put_string('   ');
     graph_off;
     position(1,19);
     put_string(pad('',' ',50));
     END;
END;

PROCEDURE load_star_ship(VAR star_ship : r_star_ship);
VAR iwork : INTEGER;
BEGIN
star_ship.fuel := 5000;
star_ship.shields := 0;
star_ship.probe_cnt := 5;
star_ship.photon_cnt := 5;
FOR iwork := 1 TO 9 DO
   star_ship.damage[iwork] := 5 + RANDOM(3 + skill_level DIV 20);
END;

PROCEDURE init_star_ship(VAR star_ship : r_star_ship);
BEGIN
star_ship.sector.x := random(15);
star_ship.sector.y := random(7);
star_ship.location.x := random(15);
star_ship.location.y := random(15);
load_star_ship(star_ship);
END;

PROCEDURE init_klingons;
VAR iwork : INTEGER;
BEGIN
klingon_cnt := 5;
FOR iwork := 1 TO klingon_cnt DO
   BEGIN
   klingon[iwork].sector.x := RANDOM(8) + 7;
   klingon[iwork].sector.y := RANDOM(8) + 7;
   klingon[iwork].location.x := RANDOM(15);
   klingon[iwork].location.y := RANDOM(15);
   klingon[iwork].hit := 0;
   klingon[iwork].miss := FALSE;
   klingon[iwork].strength := 5000;
   END;
END;

PROCEDURE init_romulans;
VAR iwork : INTEGER;
BEGIN
romulan_cnt := 5;
FOR iwork := 1 TO romulan_cnt DO
   BEGIN
   romulan[iwork].sector.x := RANDOM(7);
   romulan[iwork].sector.y := RANDOM(8) + 7;
   romulan[iwork].target_sector.x := RANDOM(15);
   romulan[iwork].target_sector.y := RANDOM(5) + 10;
   romulan[iwork].location.x := RANDOM(15);
   romulan[iwork].location.y := RANDOM(15);
   romulan[iwork].strength := 10000;
   romulan[iwork].hit := FALSE;
   romulan[iwork].miss := FALSE;
   romulan[iwork].cloak := TRUE;
   END;
END;

PROCEDURE init_sector(VAR sector : r_sector);
BEGIN
sector.probe := FALSE;
sector.base := FALSE;
END;

PROCEDURE init_location(sector_x,sector_y : INTEGER);
VAR x,y,star_index,star_cnt,iwork : INTEGER;
BEGIN
star_ship.alert_cnt := 0;

FOR y := 1 TO 15 DO
   FOR x := 1 TO 15 DO
      location[x,y] := '   ';
location[star_ship.location.x,star_ship.location.y] := star_ship_char;

FOR iwork := 1 TO 5 DO
   BEGIN
   klingon[iwork].hit := 0;
   klingon[iwork].miss := FALSE;
   IF (klingon[iwork].sector.x = sector_x) AND 
      (klingon[iwork].sector.y = sector_y)
   THEN BEGIN
        star_ship.alert_cnt := star_ship.alert_cnt + 1;
        WHILE location[klingon[iwork].location.x,klingon[iwork].location.y] <>
              '   ' DO
             BEGIN
             klingon[iwork].location.x := RANDOM(15);
             klingon[iwork].location.y := RANDOM(15);
             END;
        location[klingon[iwork].location.x,klingon[iwork].location.y] := 
           klingon_char;
        END;
   END;

FOR iwork := 1 TO 5 DO
   BEGIN
   romulan[iwork].hit := FALSE;
   romulan[iwork].miss := FALSE;
   IF (romulan[iwork].sector.x = sector_x) AND 
      (romulan[iwork].sector.y = sector_y)
   THEN BEGIN
        IF romulan[iwork].cloak
        THEN star_ship.cloak_alert_cnt := star_ship.cloak_alert_cnt + 1
        ELSE star_ship.alert_cnt := star_ship.alert_cnt + 1;

        WHILE location[romulan[iwork].location.x,romulan[iwork].location.y] <>
              '   ' DO
             BEGIN
             romulan[iwork].location.x := RANDOM(15);
             romulan[iwork].location.y := RANDOM(15);
             END;
        IF romulan[iwork].cloak
        THEN location[romulan[iwork].location.x,romulan[iwork].location.y] := 
               romulan_cloak_char
        ELSE location[romulan[iwork].location.x,romulan[iwork].location.y] := 
               romulan_char;
        END;
   END;

IF sector[sector_x,sector_y].base
THEN BEGIN
     REPEAT
        x := random(15);
        y := random(15);
     UNTIL location[x,y] = '   ';
     location[x,y] := star_base_char;
     END;

IF sector[sector_x,sector_y].probe
THEN BEGIN
     REPEAT
        x := random(15);
        y := random(15);
     UNTIL location[x,y] = '   ';
     location[x,y] := probe_char;
     END;

star_cnt := random(14 - skill_level DIV 10) + 4;
FOR star_index := 1 TO star_cnt DO
   BEGIN
   x := random(15);
   y := random(15);
   IF location[x,y] = '   '
   THEN location[x,y] := star_char;
   END;
END;

PROCEDURE initialize;
VAR x,y,base_index,base_cnt : INTEGER;
    tstr : char_11;
BEGIN
REPEAT
   WRITE(output,'ENTER SKILL LEVEL (1..100): ');
   READLN(input,skill_level);
UNTIL (skill_level > 0) AND (skill_level <= 100);

alert_mess[20] := '';
alert_mess[21] := '';
alert_mess[22] := '';
TIME(tstr);
rseed := zint(substr(tstr,7,2)) MOD (zint(substr(tstr,10,2)) + 1);
init_char;
clear_screen;

init_star_ship(star_ship);
init_klingons;
init_romulans;

FOR y := 1 TO 15 DO
   FOR x := 1 TO 15 DO
      init_sector(sector[x,y]);
base_cnt := random(4 + skill_level DIV 20) + 4;
FOR base_index := 1 TO base_cnt DO
   sector[random(15),random(7)].base := TRUE;

init_location(star_ship.sector.x,star_ship.sector.y);
END;

PROCEDURE check_base;
BEGIN
IF star_ship.location.x > 1
THEN IF location[star_ship.location.x-1,star_ship.location.y] = star_base_char
     THEN load_star_ship(star_ship);
IF star_ship.location.x < 15
THEN IF location[star_ship.location.x+1,star_ship.location.y] = star_base_char
     THEN load_star_ship(star_ship);
END;

PROCEDURE release_probe;
VAR x,y : INTEGER;
BEGIN
IF star_ship.probe_cnt = 0
THEN alert_message('No probes onboard, reload at starbase')
ELSE IF sector[star_ship.sector.x,star_ship.sector.y].probe
THEN alert_message('Probe already deployed in this sector')
ELSE IF sector[star_ship.sector.x,star_ship.sector.y].base
THEN alert_message('Starbase located in this sector, no need for probe')
ELSE BEGIN
     star_ship.probe_cnt := star_ship.probe_cnt - 1;
     REPEAT
        x := random(15);
        y := random(15);
     UNTIL location[x,y] = '   ';
     location[x,y] := probe_char;
     sector[star_ship.sector.x,star_ship.sector.y].probe := TRUE;
     IF sr_scan_on
     THEN BEGIN
          position(x*3-1,y+1);
          put_string(probe_char);
          END
     ELSE display_map;
     END;
END;

PROCEDURE damage_report;
VAR y : INTEGER;

    PROCEDURE report_damage(s : string);
    BEGIN
    y := y + 1;
    position(53,y);
    put_string(s);
    END;

BEGIN
position(53,1);
bold_rev_att_on;
put_string('     DAMAGE REPORT     ');
att_off;
y := 1;
IF star_ship.damage[1] < 0
THEN report_damage('damage control out     ')
ELSE BEGIN
     IF star_ship.damage[2] < 0
     THEN report_damage('phasors out            ');
     IF star_ship.damage[3] < 0
     THEN report_damage('photons out            ');
     IF star_ship.damage[4] < 0
     THEN report_damage('shield control out     ');
     IF star_ship.damage[5] < 0
     THEN report_damage('long range scanners out');
     IF star_ship.damage[6] < 0
     THEN report_damage('short range sensors out');
     IF star_ship.damage[7] < 0
     THEN report_damage('auxiliary drive out    ');
     IF star_ship.damage[8] < 0
     THEN report_damage('warp drive out         ');
     IF star_ship.damage[9] < 0
     THEN report_damage('communications out     ');
     END;
WHILE y <= 9 DO
     BEGIN
     y := y + 1;
     position(53,y);
     put_string('                       ');
     END;
END;

PROCEDURE display_user_option;
BEGIN
position(53,12);
put_string('0. S.R. scan           ');
position(53,13);
put_string('1. L.R. scan           ');
position(53,14);
put_string('2. display map         ');
position(53,15);
put_string('3. fire phasors        ');
position(53,16);
put_string('4. fire photons        ');
position(53,17);
put_string('5. damage report       ');
position(53,18);
put_string('6. power to shields    ');
position(53,19);
put_string('7. warp drive          ');
position(53,20);
put_string('8. auxiliary drive     ');
position(53,21);
put_string('9. release probe       ');
END;

PROCEDURE user_direction(s : string; VAR angle : INTEGER);
BEGIN
position(53,12);
put_string(PAD(s,' ',23));
position(53,13);
put_string('                       ');
position(53,14);
put_string('     270               ');
position(53,15);
put_string('  225 | 315            ');
position(53,16);
put_string('180---+---0            ');
position(53,17);
put_string('  135 | 45             ');
position(53,18);
put_string('     90                ');
position(53,19);
put_string('                       ');
position(53,20);
put_string('Angle:                 ');
position(53,21);
put_string('                       ');
read_number(60,20,angle);
END;

PROCEDURE record_hit(sector_x,sector_y,x,y,units : INTEGER);
VAR iwork : INTEGER;
BEGIN
IF location[x,y] = probe_char
THEN BEGIN
     sector[sector_x,sector_y].probe := FALSE;
     location[x,y] := '   ';
     IF sr_scan_on 
     THEN BEGIN
          position(x*3-1,y+1);
          put_string('   ');
          END
     ELSE BEGIN
          IF sector_y < 8
          THEN IF sector_x < 8
               THEN position(sector_x*3,sector_y+1)
               ELSE position(sector_x*3+1,sector_y+1)
          ELSE IF x < 8
               THEN position(sector_x*3,sector_y+2)
               ELSE position(sector_x*3+1,sector_y+2);
          put_char(' ');
          END;
     END;
IF location[x,y] = star_base_char
THEN BEGIN
     sector[sector_x,sector_y].base := FALSE;
     location[x,y] := '   ';
     IF sr_scan_on 
     THEN BEGIN
          position(x*3-1,y+1);
          put_string('   ');
          END
     ELSE BEGIN
          IF sector_y < 8
          THEN IF sector_x < 8
               THEN position(sector_x*3-1,sector_y+1)
               ELSE position(sector_x*3,sector_y+1)
          ELSE IF x < 8
               THEN position(sector_x*3-1,sector_y+2)
               ELSE position(sector_x*3,sector_y+2);
          put_char(' ');
          END;
     END;
FOR iwork := 1 TO 5 DO
   BEGIN
   IF (klingon[iwork].sector.x = sector_x) AND 
      (klingon[iwork].sector.y = sector_y) AND
      (klingon[iwork].location.x = x) AND
      (klingon[iwork].location.y = y)
   THEN BEGIN
        alert_message('Klingon ship hit!');
        klingon[iwork].hit := klingon[iwork].hit + 1;
        klingon[iwork].strength := klingon[iwork].strength - units;
        IF klingon[iwork].strength < 0
        THEN BEGIN
             alert_message('Klingon ship destroyed!');
             klingon[iwork].sector.x := 0;
             location[klingon[iwork].location.x,klingon[iwork].location.y]
                 := '   ';
             IF sr_scan_on
             THEN BEGIN
                  position(klingon[iwork].location.x*3-1,
                     klingon[iwork].location.y+1);
                  put_string('   ');
                  END;
             klingon_cnt := klingon_cnt - 1;
             IF (klingon_cnt = 0) AND (romulan_cnt = 0) 
             THEN term_game(3);
             star_ship.alert_cnt := star_ship.alert_cnt - 1;
             display_condition;
             END;
        END;
   IF (romulan[iwork].sector.x = sector_x) AND 
      (romulan[iwork].sector.y = sector_y) AND
      (romulan[iwork].location.x = x) AND
      (romulan[iwork].location.y = y)
   THEN BEGIN
        alert_message('Romulan ship hit!');
        romulan[iwork].hit := TRUE;
        romulan[iwork].strength := romulan[iwork].strength - units;
        IF romulan[iwork].strength < 0
        THEN BEGIN
             alert_message('Romulan ship destroyed!');
             romulan[iwork].sector.x := 0;
             location[romulan[iwork].location.x,romulan[iwork].location.y]
                 := '   ';
             IF sr_scan_on
             THEN BEGIN
                  position(romulan[iwork].location.x*3-1,
                     romulan[iwork].location.y+1);
                  put_string('   ');
                  END;
             romulan_cnt := romulan_cnt - 1;
             IF (klingon_cnt = 0) AND (romulan_cnt = 0) 
             THEN term_game(3);
             IF romulan[iwork].cloak
             THEN star_ship.cloak_alert_cnt := star_ship.cloak_alert_cnt - 1
             ELSE star_ship.alert_cnt := star_ship.alert_cnt - 1;
             display_condition;
             END;
        END;
   END;
END;

PROCEDURE fire_photons;
VAR angle,dist,x,y : INTEGER;
    rad : REAL;
    collision,new_sector : BOOLEAN;
BEGIN
IF star_ship.damage[3] < 0
THEN alert_message('Photon fire control is inopperative')
ELSE IF star_ship.photon_cnt = 0
THEN alert_message('Photon supply depleted, supply awaits at starbase')
ELSE BEGIN
     user_direction('PHOTON FIRING CONTROL',angle);
     rad := angle * 0.01746032;
     star_ship.photon_cnt := star_ship.photon_cnt - 1;
     dist := 1;
     collision := FALSE;
     new_sector := FALSE;
     WHILE (NOT collision) AND (NOT new_sector) DO
          BEGIN
          x := star_ship.location.x + ROUND(dist * cos(rad));
          y := star_ship.location.y + ROUND(dist * sin(rad));
          IF (x < 1) OR (x > 15) OR (y < 1) OR (y > 15)
          THEN new_sector := TRUE
          ELSE IF location[x,y] <> '   '
               THEN collision := TRUE
               ELSE BEGIN
                    IF sr_scan_on
                    THEN BEGIN
                         position(x*3,y+1);
                         put_char('*');
                         position(x*3,y+1);
                         put_line;
                         lib$wait(0.015);
                         put_char(' ');
                         END;
                    dist := dist + 1;
                    END;
          END;
     IF collision
     THEN record_hit(star_ship.sector.x,star_ship.sector.y,x,y,1000);
     END;
END;

PROCEDURE fire_phasors;
VAR angle,dist,x,y,erase_x,erase_y,erase_dist,units : INTEGER;
    rad : REAL;
    collision,new_sector : BOOLEAN;
BEGIN
IF star_ship.damage[2] < 0
THEN alert_message('Phasor fire control is inopperative')
ELSE BEGIN
     user_direction('PHASOR FIRING CONTROL',angle);
     position(53,21);
     put_string('Units:');
     read_number(60,21,units);
     IF (units <= star_ship.fuel) AND (units > 0)
     THEN BEGIN
          rad := angle * 0.01746032;
          erase_dist := 1;
          dist := 1;
          collision := FALSE;
          new_sector := FALSE;
          WHILE (NOT collision) AND (NOT new_sector) DO
               BEGIN
               x := star_ship.location.x + ROUND(dist * cos(rad));
               y := star_ship.location.y + ROUND(dist * sin(rad));
               IF (x < 1) OR (x > 15) OR (y < 1) OR (y > 15)
               THEN new_sector := TRUE
               ELSE IF location[x,y] <> '   '
                    THEN collision := TRUE
                    ELSE BEGIN
                         IF dist > 4
                         THEN BEGIN
                              erase_x := star_ship.location.x + 
                                 ROUND(erase_dist * cos(rad));
                              erase_y := star_ship.location.y + 
                                 ROUND(erase_dist * sin(rad));
                              IF sr_scan_on
                              THEN BEGIN
                                   position(erase_x*3,erase_y+1);
                                   put_char(' ');
                                   END;
                              erase_dist := erase_dist + 1;
                              END;
                         IF sr_scan_on
                         THEN BEGIN
                              position(x*3,y+1);
                              put_char('o');
                              put_line;
                              lib$wait(0.01);
                              END;
                         dist := dist + 1;
                         END;
               END;
          WHILE (erase_dist < dist) AND sr_scan_on DO
               BEGIN
               erase_x := star_ship.location.x + ROUND(erase_dist * cos(rad));
               erase_y := star_ship.location.y + ROUND(erase_dist * sin(rad));
               position(erase_x*3,erase_y+1);
               put_char(' ');
               put_line;
               lib$wait(0.01);
               erase_dist := erase_dist + 1;
               END;
          IF collision
          THEN record_hit(star_ship.sector.x,star_ship.sector.y,x,y,units);
          star_ship.fuel := star_ship.fuel - units;
          IF ((star_ship.fuel + star_ship.shields) = 0)
          THEN term_game(4);
          END
     ELSE ring_bell;
     END;
END;

PROCEDURE auxiliary_drive;
VAR angle,speed,dist,x,y : INTEGER;
    collision,new_sector : BOOLEAN;
    rad : REAL;
BEGIN
IF star_ship.damage[7] < 0
THEN alert_message('Auxilliary engines are out')
ELSE BEGIN
     user_direction('AUXILIARY NAVIGATION',angle);
     rad := angle * 0.01746032;
     position(53,21);
     put_string('Speed:');
     read_number(60,21,speed);
     IF (speed < 1) OR (speed > 15)
     THEN ring_bell
     ELSE BEGIN
          IF star_ship.fuel - speed * 10 < 0
          THEN alert_message('Insufficient fuel')
          ELSE BEGIN
               star_ship.fuel := star_ship.fuel - speed * 10;
               IF ((star_ship.fuel + star_ship.shields) = 0)
               THEN term_game(4);
               dist := 1;
               collision := FALSE;
               new_sector := FALSE;
               location[star_ship.location.x,star_ship.location.y] := '   ';
               IF sr_scan_on
               THEN BEGIN
                    position(star_ship.location.x*3-1,star_ship.location.y+1);
                    put_string('   ');
                    END;
               WHILE (dist <= speed) AND (NOT collision) AND (NOT new_sector) DO
                    BEGIN
                    x := star_ship.location.x + ROUND(dist * cos(rad));
                    y := star_ship.location.y + ROUND(dist * sin(rad));
                    IF (x < 1) OR (x > 15) OR (y < 1) OR (y > 15)
                    THEN new_sector := TRUE
                    ELSE IF location[x,y] <> '   '
                         THEN collision := TRUE
                         ELSE dist := dist + 1;
                    END;
               IF collision
               THEN speed := dist - 1;
               star_ship.location.x := star_ship.location.x + 
                    ROUND(speed * cos(rad));
               star_ship.location.y := star_ship.location.y + 
                    ROUND(speed * sin(rad));
               IF new_sector
               THEN BEGIN
                    IF star_ship.location.x < 1
                    THEN BEGIN
                         star_ship.sector.x := star_ship.sector.x - 1;
                         IF star_ship.sector.x < 1
                         THEN term_game(1);
                         star_ship.location.x := 15 + star_ship.location.x;
                         END
                    ELSE BEGIN
                         IF star_ship.location.x > 15
                         THEN BEGIN
                              star_ship.sector.x := star_ship.sector.x + 1;
                              IF star_ship.sector.x > 15
                              THEN term_game(1);
                              star_ship.location.x := star_ship.location.x - 15;
                              END;
                         END;
                    IF star_ship.location.y < 1
                    THEN BEGIN
                         star_ship.sector.y := star_ship.sector.y - 1;
                         IF star_ship.sector.y < 1
                         THEN term_game(1);
                         star_ship.location.y := 15 + star_ship.location.y;
                         END
                    ELSE BEGIN
                         IF star_ship.location.y > 15
                         THEN BEGIN
                              star_ship.sector.y := star_ship.sector.y + 1;
                              IF star_ship.sector.y > 15
                              THEN term_game(1);
                              star_ship.location.y := star_ship.location.y - 15;
                              END;
                         END;
                    init_location(star_ship.sector.x,star_ship.sector.y);
                    IF sr_scan_on
                    THEN display_location
                    ELSE display_map;
                    END
               ELSE BEGIN
                    location[star_ship.location.x,star_ship.location.y] := 
                       star_ship_char;
                    IF sr_scan_on
                    THEN BEGIN
                         position(star_ship.location.x*3-1,
                                  star_ship.location.y+1);
                         put_string(star_ship_char);
                         END
                    ELSE display_map;
                    END;
               check_base;
               END;
          END;
     END;
END;

PROCEDURE warp_drive;
VAR angle,speed,dist,x,y : INTEGER;
    collision,new_sector : BOOLEAN;
    rad : REAL;
BEGIN
IF star_ship.damage[8] < 0
THEN alert_message('Warp drive  engines are out')
ELSE BEGIN
     user_direction('WARP DRIVE NAVIGATION',angle);
     rad := angle * 0.01746032;
     position(53,21);
     put_string('Warp factor:');
     read_number(66,21,speed);
     IF (speed < 1) OR (speed > 15)
     THEN ring_bell
     ELSE BEGIN
          IF star_ship.fuel - speed * 150 < 0
          THEN alert_message('Insufficient fuel')
          ELSE BEGIN
               star_ship.fuel := star_ship.fuel - speed * 150;
               IF ((star_ship.fuel + star_ship.shields) = 0)
               THEN term_game(4);
               dist := 1;
               collision := FALSE;
               new_sector := FALSE;
               location[star_ship.location.x,star_ship.location.y] := '   ';
               WHILE (NOT collision) AND (NOT new_sector) DO
                    BEGIN
                    x := star_ship.location.x + ROUND(dist * cos(rad));
                    y := star_ship.location.y + ROUND(dist * sin(rad));
                    IF (x < 1) OR (x > 15) OR (y < 1) OR (y > 15)
                    THEN new_sector := TRUE
                    ELSE IF location[x,y] <> '   '
                         THEN collision := TRUE
                         ELSE dist := dist + 1;
                    END;
               IF collision
               THEN BEGIN
                    speed := dist - 1;
                    star_ship.location.x := star_ship.location.x + 
                        ROUND(speed * cos(rad));
                    star_ship.location.y := star_ship.location.y + 
                        ROUND(speed * sin(rad));
                    location[star_ship.location.x,star_ship.location.y] := 
                       star_ship_char;
                    END
               ELSE BEGIN
                    star_ship.sector.x := star_ship.sector.x + 
                        ROUND(speed * cos(rad));
                    star_ship.sector.y := star_ship.sector.y + 
                        ROUND(speed * sin(rad));
                    IF (star_ship.sector.x < 1) OR (star_ship.sector.x > 15) OR
                       (star_ship.sector.y < 1) OR (star_ship.sector.y > 15)
                    THEN term_game(1);
                    init_location(star_ship.sector.x,star_ship.sector.y);
                    END;
               check_base;
               END;
          END;
     END;
END;

PROCEDURE long_range_sensors;
VAR x,y,ry,iwork : INTEGER;
    sector_match : BOOLEAN;
BEGIN
IF star_ship.damage[5] < 0
THEN alert_message('Long range sensors out')
ELSE BEGIN
     position(53,1);
     bold_rev_att_on;
     put_string('LONG RANGE SENSOR SCAN ');
     att_off;
     ry := 1;
     FOR y := star_ship.sector.y - 1 TO star_ship.sector.y + 1 DO
        FOR x := star_ship.sector.x - 1 TO star_ship.sector.x + 1 DO
           BEGIN
           sector_match := FALSE;
           IF (x >= 1) AND (x <= 15) AND (y >= 1) AND (y <= 15)
           THEN FOR iwork := 1 TO 5 DO
                   IF ((klingon[iwork].sector.x = x) AND
                       (klingon[iwork].sector.y = y)) OR 
                      ((romulan[iwork].sector.x = x) AND
                       (romulan[iwork].sector.y = y))
                   THEN sector_match := TRUE;
           IF sector_match
           THEN BEGIN
                ry := ry + 1;
                position(53,ry);
                put_string('Sector (');
                put_string(zfill2(x));
                put_char(',');
                put_string(zfill2(y));
                put_string(')         ');
                END;
           END;
     WHILE ry < 10 DO
          BEGIN
          ry := ry + 1;
          position(53,ry);
          put_string('                       ');
          END;
     END;
END;

PROCEDURE power_to_shields;
VAR d_power,y : INTEGER;
BEGIN
IF star_ship.damage[4] < 0
THEN alert_message('Shield control not operational')
ELSE BEGIN
     position(53,12);
     put_string('SHIELD CONTROL         ');
     position(53,13);
     put_string('                       ');
     position(53,14);
     put_string('Units:                 ');
     FOR y := 15 TO 21 DO
        BEGIN
        position(53,y);
        put_string('                       ');
        END;
     read_number(60,14,d_power);
     IF d_power < 0
     THEN BEGIN
          IF ABS(d_power) > star_ship.shields
          THEN d_power := 0 - star_ship.shields;
          END
     ELSE BEGIN
          IF d_power > star_ship.fuel
          THEN d_power := star_ship.fuel;
          END;
     star_ship.fuel := star_ship.fuel - d_power;
     star_ship.shields := star_ship.shields + d_power;
     END;
END;

PROCEDURE get_user_options;
VAR achar : char;
BEGIN
sr_scan_on := TRUE;
REPEAT
  achar := ' ';
  position(1,23);
  achar := get_char_wait;
  CASE achar OF
    '0':BEGIN
        display_location;
        display_condition;
        sr_scan_on := TRUE;
        END;
    '1':long_range_sensors;
    '2':BEGIN
        display_map;
        sr_scan_on := FALSE;
        END;
    '3':BEGIN
        fire_phasors;
        display_condition;
        display_user_option;
        END;
    '4':BEGIN
        fire_photons;
        display_condition;
        display_user_option;
        END;
    '5':damage_report;
    '6':BEGIN
        power_to_shields;
        display_condition;
        display_user_option;
        END;
    '7':BEGIN
        warp_drive;
        display_condition;
        display_user_option;
        IF sr_scan_on
        THEN display_location
        ELSE display_map;
        END;
    '8':BEGIN
        auxiliary_drive;
        display_condition;
        display_user_option;
        END;
    '9':BEGIN
        release_probe;
        display_condition;
        END;
    ' ',
    'Q',
    'q':;
     OTHERWISE ring_bell;
    END;
UNTIL achar IN ['Q','q'];
END;

BEGIN
initialize;
display_location;
display_condition;
display_user_option;
get_user_options;
END.