-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X  qio_write (outline);
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE  ERROR ( text : `5BTRUNCATE`5D v_array );
XBEGIN
X  writeln ( VT100 + VT100_graphics_off + VT100_normal + VT100_normal_scroll
V + VT100_no_application_keypad + VT100_ESC + '`5BJ' );
X  IF present(text) then
X    writeln (text)
X  else
X    writeln ('No Message');
X  $EXIT;
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  Get_Posn ( x , y : integer ) : v_array;
XVAR
X  outline,sx,sy : v_array;
XBEGIN
X  outline := VT100_ESC + '`5B';
X
X  IF ( y > 1 ) then
X    BEGIN
X      writev (sy,y:1);
X      outline := outline + sy;
X    END;
X
X  IF ( x > 1 ) then
X    BEGIN
X      writev (sx,x:1);
X      outline := outline + ';' + sx;
X    END;
X
X  get_posn := outline + 'H';
XEND;
X
X`5BGLOBAL`5D
XPROCEDURE  Posn ( x , y : integer );
XBEGIN
X  qio_write (get_posn(x,y));
XEND;
X
X
X`5BHIDDEN`5D
XVAR
X  seed : integer;
X  seed_initialized : boolean;
X
X
X`5BGLOBAL`5D
XPROCEDURE  Seed_initialize ( users_seed : `5BTRUNCATE`5D integer );
XVAR
X  time : packed array `5B0..1`5D of integer;
XBEGIN
X  seed_initialized := true;
X  IF present(users_seed) then
X    seed := users_seed
X  ELSE
X    BEGIN
X      $gettim(time);
X      seed := time`5B0`5D;
X    END;
XEND;
X
X
X`5BGLOBAL`5D
XFUNCTION  Random ( ub : integer ) : integer;
X`7B Produce random integer between 1 & ub inclusive `7D
X
X        FUNCTION  Mth$Random ( VAR seed : integer ) : real;
X          extern;
X
XBEGIN
X  If not seed_initialized then
X    seed_initialize;
X  Random := Trunc (( Mth$Random ( seed ) * ub ) + 1);
XEND; `7B Random `7D
X
X
X`5BGLOBAL`5D
XFUNCTION  Rnd ( lb, ub : integer ) : integer;
X`7B Produce random integer between lb & ub `7D
X
X        FUNCTION  Mth$Random ( VAR seed : integer ) : real;
X          extern;
X
XBEGIN
X  If not seed_initialized then
X    seed_initialize;
X  rnd := Trunc (( Mth$Random ( seed ) * (ub-lb+1) ) + lb );
XEND; `7B Random `7D
X
X
X`5BGLOBAL`5D
XFUNCTION  _Dec ( number    : integer;
X                pad_char  : char := ' ';
X                pad_len   : integer := 0
X              ) : v_array;
XVAR
X  Result : v_array;
XBEGIN
X  Writev (result,number:0);
X  WHILE ( result.length < abs(pad_len) ) do
X    IF ( pad_len < 0 ) then
X      result := result + pad_char
X    ELSE
X      result := pad_char + result;
X  _dec := result;
XEND;
X
X`5BGLOBAL`5D
XFUNCTION  Get_jpi_Str ( jpicode , retlen : integer ) : v_array;
XVAR
X  itemlist    : record
X                  item : array `5B1..1`5D of`20
X                    record
X                      bufsize : $uword;
X                      code    : $uword;
X                      bufadr  : integer;
X                      lenadr  : integer
X                    end;
X                  no_more : integer;
X                end;
X  name : packed array `5B1..256`5D of char;
X  retname : v_array;
XBEGIN
X  WITH itemlist do
X   BEGIN
X     WITH item`5B1`5D do
X       BEGIN
X         Bufsize := retlen;
X         Code := jpicode;
X         Bufadr := iaddress(name);
X         Lenadr := 0
X       END;
X     No_more := 0
X   END;
X  System_Call ($Getjpiw(itmlst := itemlist));
X  retname := name;
X  retname.length := retlen;
X  get_jpi_str := retname;
XEND;
X
XFUNCTION  Get_jpi_Val ( jpicode : INTEGER ) : UNSIGNED;
XVAR
X  itemlist    : record
X                  item : array `5B1..1`5D of`20
X                    record
X                      bufsize : $uword;
X                      code    : $uword;
X                      bufadr  : integer;
X                      lenadr  : integer
X                    end;
X                  no_more : integer;
X                end;
X  resulting_value : UNSIGNED;
X  retname : v_array;
XBEGIN
X  WITH itemlist do
X   BEGIN
X     WITH item`5B1`5D do
X       BEGIN
X         Bufsize := 4;
X         Code := jpicode;
X         Bufadr := iaddress(resulting_value);
X         Lenadr := 0
X       END;
X     No_more := 0
X   END;
X  System_Call ($Getjpiw(itmlst := itemlist));
X  get_jpi_val := resulting_value;
XEND;
X
X`5BHIDDEN`5DVAR
X  image_dir_done : boolean;
X
X
X`5BGLOBAL`5D
XPROCEDURE  Image_dir;
XVAR
X  itemlist    : record
X                  item : array `5B1..1`5D of`20
X                    record
X                      bufsize : $uword;
X                      code    : $uword;
X                      bufadr  : integer;
X                      lenadr  : integer
X                    end;
X                  no_more : integer;
X                end;
X  the_name : v_array;
X  name_str : packed array `5B1..256`5D of char;
XBEGIN
X  IF not image_dir_done then
X    BEGIN
X      image_dir_done := true;
X      the_name := Get_jpi_str(jpi$_imagname,100);
X   `20
X      WHILE ( index(the_name,'`5D`5B') <> 0 ) do
X        BEGIN
X          the_name := substr(the_name,1,index(the_name,'`5D`5B')-1) + substr
V(the_name,index(the_name,'`5D`5B')+2,length(the_name)-(index(the_name,'`5D`5
VB')+2));
X        END;
X   `20
X      the_name := substr(the_name,1,index(the_name,'`5D'));
X      name_str := the_name;
X   `20
X      WITH itemlist do
X       BEGIN
X         WITH item`5B1`5D do
X           BEGIN
X             Bufsize := length(the_name);
X             Code := lnm$_string;
X             Bufadr := iaddress(name_str);
X             Lenadr := 0
X           END;
X         No_more := 0
X       END;
X
X      System_Call ($Crelnm (tabnam:='LNM$PROCESS_TABLE',
X                             lognam:='IMAGE_DIR',
X                             itmlst:=itemlist ));
X    END;
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE  Square ( x1 , y1 , x2 , y2 : integer );
XVAR
X  i : integer;
X  sx : v_array;
X  buffer : v_array;
XBEGIN
X  IF ( x1 > x2 - 1 ) or ( y1 > y2 - 1 ) then
X    ERROR ('%INTERACT-SQUARE, Top Corner Bottom Corner Overlap');
X  IF ( abs(x2-x1) > 132 ) then
X    ERROR ('%INTERACT-SQUARE, Size Error delta x distance too large.');
X  IF ( abs(y2-y1) > 24 ) then
X    ERROR ('%INTERACT-SQUARE, Size Error delta y distance too large.');
X
X  buffer := get_posn (x1,y1) + VT100_graphics_on + 'l';
X  FOR i := x1+1 to x2-1 do
X    buffer := buffer + 'q';
X  buffer := buffer + 'k';
X  qio_write (buffer);
X  writev(sx,x2-x1-1:1);
X  sx := 'x' + VT100_ESC + '`5B' + sx + 'C' + 'x';
X  FOR i := y1+1 to y2-1 do
X    qio_write ( get_posn(x1,i)+ sx );
X  buffer := get_posn (x1,y2) + 'm';
X  IF ( x1 < x2 - 1 ) then
X    FOR i := x1+1 to x2-1 do
X      buffer := buffer + 'q';
X  buffer := buffer + 'j' + VT100_graphics_off;
X  qio_write (buffer);
XEND;
X
X
X`5BGLOBAL`5D
XPROCEDURE  Reset_screen;
XBEGIN
X  qio_write ( VT100 + VT100_graphics_off + VT100_normal + VT100_normal_scrol
Vl + VT100_no_application_keypad );
XEND;
X
X`5BHIDDEN`5D
XVAR
X  ingraphedt     : text;
X
X`5BGLOBAL`5D
XFUNCTION Show_graphedt ( filename : v_array; wait : boolean := true ) : CHAR
V;
X(*`20
X  IF wait is true then the character that is pressed is returned, otherwise
X   chr(255) is returned
X*)
XVAR
X  line : v_array;
X  rep : char := chr(255);
X  ret_val : char;
XBEGIN
X  IF not image_dir_done then
X    Image_dir;
X  IF ( wait ) then
X    rep := qio_1_char_now;
X  OPEN (ingraphedt,'image_dir:'+filename,history:=readonly,error:=continue);
X  IF status(ingraphedt) = 0 then
X    BEGIN
X      reset (ingraphedt);
X      WHILE not eof(ingraphedt) and (( rep = chr(-1)) or ( not wait )) do
X        BEGIN
X          IF wait then
X            rep := qio_1_char_now;
X          readln (ingraphedt,line);
X          qio_writeln(line);
X        END;
X      close (ingraphedt);
X      posn (1,1);
X      IF wait and ( rep = chr(-1) ) then
X        rep := qio_1_char;
X    END
X  ELSE
X    BEGIN
X      clear;
X      posn (18,10);
X      qio_write ('couldn''t find filename .... '+filename);
X      posn (28,20);
X      qio_write (VT100_Bright+'Press  <'+VT100_Flash+'Return'+VT100_normal+V
VT100_bright+'>'+VT100_normal);
X      posn (1,1);
X      IF ( rep  = chr(-1) ) then
X        rep := qio_1_char;
X    END;
X  reset_screen;
X  Show_GraphEdt := rep;
XEND;
X
X`5BGLOBAL`5D
XFUNCTION  Full_char ( character : char ) : v_array;
XVAR
X  c : integer;
XBEGIN
X  c := ord(character);
X  IF ( c in `5B0..31,127`5D ) then
X    full_char := VT100_inverse + chr(64+c) + VT100_normal
X  ELSE
X  IF ( c < 128 ) then
X    full_char := character
X  ELSE
X  IF ( (c-128) in `5B0..31,127`5D ) then
X    full_char := VT100_inverse + VT100_bright + chr(c-64) + VT100_normal
X  ELSE
X    full_char := VT100_bright + character;
XEND;
X
X
X`5BGlobal`5D
XPROCEDURE  Formated_read
X (VAR return_value   : v_array;
X      picture_clause : v_array;
X      x_posn         : integer;
X      y_posn         : integer;
X      default_value  : v_array := '';
X      field_full_terminate : boolean := false;
X      begin_brace    : v_array := '';
X      end_brace      : v_array := ''
X );
XVAR
X  i : integer;
X  ch : char;
X  outline : v_array;
X
X
X    PROCEDURE  Go_left;
X    BEGIN
X      IF ( i <> 1 ) then
X        BEGIN
X          REPEAT
X            i := i - 1;
X          UNTIL ( i = 1 ) or ( picture_clause`5Bi`5D in `5B'9','X'`5D );
X          IF not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) then
X            BEGIN
X              WHILE not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) do
X                i := i + 1;
X            END;
X        END;
X    END;
X
X
X    PROCEDURE  Go_right;
X    BEGIN
X      IF ( i <> length(picture_clause) ) then
X        BEGIN
X          REPEAT
X            i := i + 1;
X          UNTIL ( i = length(picture_clause) ) or ( picture_clause`5Bi`5D in
V `5B'9','X'`5D );
X          IF not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) then
X            BEGIN
X              WHILE not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) do
X                i := i - 1;
X            END;
X        END;
X    END;
X
X
X    PROCEDURE  Escape_sequence;
X    BEGIN
X      ch := qio_1_char;
X      IF ( ch = '`5B' ) then
X        BEGIN
X          ch := qio_1_char;
X          CASE ch of
X            'C' : go_right;
X            'D' : go_left;
X            Otherwise
X             qio_write (chr(7));               `20
X          End;
X        END
X      ELSE
X        qio_write (chr(7));               `20
X    END;
X
X
X    PROCEDURE  Delete;
X    VAR
X      last : integer;
X    BEGIN
X      IF ( i <> 1 ) then
X        BEGIN
X          last := length(picture_clause)+1;
X          REPEAT
X            last := last - 1;
X          UNTIL ( last = 1 ) or ( picture_clause`5Blast`5D in `5B'9','X'`5D
V );
X
X          IF ( i <> last ) or ( return_value`5Bi`5D = ' ' ) then
X            REPEAT
X              i := i - 1;
X            UNTIL ( i = 1 ) or ( picture_clause`5Bi`5D in `5B'9','X'`5D );
X
X          IF not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) then
X            BEGIN
X              WHILE not ( picture_clause`5Bi`5D in `5B'9','X'`5D ) do
X                i := i + 1;
X            END
X          ELSE
X            BEGIN
X              posn (x_posn+i-1,y_posn);
X               qio_write (' '+VT100_bs);
X              return_value`5Bi`5D := ' ';
X            END;
X        END;
X    END;
X
X
X    PROCEDURE  Key_control;
X    BEGIN
X      IF ( ch = chr(13) ) then
X        BEGIN
X          field_full_terminate := true;
X          i := length(picture_clause) + 1;
X        END
X      ELSE
X      IF ( ch = chr(27) ) then
X        escape_sequence
X      ELSE
X      IF ( ch = chr(127) ) then
X        delete
X      ELSE
X        qio_write (chr(7));               `20
X    END;
X
X
XBEGIN
X  return_value := '';
X
X`7B get x & y if left out `7D
X
X  FOR i := 1 to length(picture_clause) do
X      CASE picture_clause`5Bi`5D of
X        '9' : IF length(default_value) < i then
X                return_value := return_value + ' '
X              ELSE
X              IF ( default_value`5Bi`5D in `5B' ','0'..'9'`5D ) then
X                return_value := return_value + default_value`5Bi`5D
X              ELSE
X                ERROR ('DEFAULT VALUE /'+default_value`5Bi`5D+'/ DOES NOT MA
VTCH PICTURE CLAUSE /'+picture_clause`5Bi`5D+'/');
X        'X' : IF length(default_value) < i then
X                return_value := return_value + ' '
X              ELSE
X              IF ( default_value`5Bi`5D in `5B' '..'`7E'`5D ) then
X                return_value := return_value + default_value`5Bi`5D
X              ELSE
X                ERROR ('%INTERACT-F-DVMM, DEFAULT VALUE /'+full_char(default
V_value`5Bi`5D)+'/ DOES NOT MATCH PICTURE CLAUSE /'+picture_clause`5Bi`5D+'/'
V);
X       otherwise`20
X          return_value := return_value + picture_clause`5Bi`5D;
X      End;
X
X  outline := '';
X
X  posn (x_posn,y_posn);
X  IF length(begin_brace) > 0 then
X    outline := outline + begin_brace;
X  outline := outline + return_value;
X  IF length(end_brace) > 0 then
X    outline := outline + end_brace;
X
X  qio_write (outline);
X
X  IF length(begin_brace) > 0 then
X    x_posn := x_posn + length(begin_brace);
X
X  i := 1;
X  REPEAT
X    WHILE ( i <= length(picture_clause) ) do
X      BEGIN
X        posn (x_posn+i-1,y_posn);
X        CASE picture_clause`5Bi`5D of
X          '9' : BEGIN
X                  ch := qio_1_char;
X                  IF ( ch in `5B' ','0'..'9'`5D ) then
X                    BEGIN
X                      return_value`5Bi`5D := ch;
X                      qio_write (ch);
X                      i := i + 1;
X                    END
X                  ELSE
X                    key_control;
X                END;
X          'X' : BEGIN
X                  ch := qio_1_char;
X                  IF ( ch in `5B' '..'`7E'`5D ) then
X                    BEGIN
X                      return_value`5Bi`5D := ch;
X                      qio_write (ch);
X                      i := i + 1;
X                    END
X                  ELSE
X                    key_control;
X                END;
X         otherwise`20
X            i := i + 1;
X        End;
X      END;
X    IF ( i > length(picture_clause) ) and ( not field_full_terminate ) then
X      i := length(picture_clause);
X  UNTIL ( i > length(picture_clause) );
XEND;
X
X
X`5BASYNCHRONOUS, EXTERNAL(STR$TRIM)`5D
XFUNCTION  $Trim
X  ( VAR destination_str : `5BCLASS_S`5D PACKED ARRAY `5B$L1 .. $U1 : INTEGER
V`5D OF CHAR;
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-