IMPLEMENTATION MODULE REGISGraphics;

(* simple REGIS Graphics routines *)
(* the offsets are used, but as far as the user is concerned there is
   no offset, just that smaller dimensions are used *)
(* J. Andrea, Apr.30/91 *)
(* This code may be freely used and distributed, it may not be sold. *)

FROM FileSystem IMPORT Done, Create, Close, WriteChar, File;
FROM MathLib0   IMPORT sin, cos;

CONST
   absolute_rows = 475;
   absolute_cols = 790;

   row_offset    = 20;
   col_offset    =  0;

   max_rows      = absolute_rows - row_offset;
   max_cols      = absolute_cols - col_offset;

   esc = 33C;

VAR
  current_row, current_col :CARDINAL;
  true_row,    true_col    :CARDINAL;

  output_open, regis_on :BOOLEAN;

  biggest :CARDINAL;

  digits  :ARRAY [0..9] OF CHAR;
  i       :CARDINAL;

  outf :File;

(* ----------------------------------------------------------------- *)
PROCEDURE CheckLocation( row, col :CARDINAL; VAR new_row, new_col :CARDINAL );
(* don't allow new position to be out of bounds *)
BEGIN
   IF row > max_rows THEN row := max_rows; END;
   IF col > max_cols THEN col := max_cols; END;
   new_row := row;   new_col := col;
END CheckLocation;

(* ----------------------------------------------------------------- *)
PROCEDURE TrueLocation;
(* and invert positions so that y (rows) run bottom to top,
   and apply offsets as required *)
BEGIN
   true_row := absolute_rows - current_row;
   true_col := current_col + col_offset;
END TrueLocation;

(* ----------------------------------------------------------------- *)
PROCEDURE Output( string :ARRAY OF CHAR );
(* write the given string to the output file *)
VAR i, L :CARDINAL;
BEGIN
  L := LEN( string ) - 1;
  FOR i := 0 TO L DO
    WriteChar( outf, string[i] );
  END;
END Output;

(* ----------------------------------------------------------------- *)
PROCEDURE OutputNumber( x :CARDINAL );
(* assumption that x is less than 1000 *)

BEGIN

  IF x > 99 THEN

    (* 3 digits *)

    i := x DIV 100;
    WriteChar( outf, digits[i] );
    x := x - 100 * i;
    i := x DIV 10;
    WriteChar( outf, digits[i] );
    x := x - 10 * i;
    WriteChar( outf, digits[x] );

  ELSE
    IF x > 9 THEN

      (* 2 digits *)

      i := x DIV 10;
      WriteChar( outf, digits[i] );
      x := x - 10 * i;
      WriteChar( outf, digits[x] );

    ELSE

      (* 1 digit *)

      WriteChar( outf, digits[x] );

    END;
  END;

END OutputNumber;

(* ----------------------------------------------------------------- *)
PROCEDURE BeginRegis( filename :ARRAY OF CHAR );
(* define the output file to hold the graphics commands,
   if interactive graphics then define filename as SYS$OUTPUT *)
BEGIN
  IF output_open THEN  EndRegis;  END;

  Create( outf, filename, TRUE, FALSE );

  IF Done() THEN
    output_open := TRUE;
    RegisOn;
  END;
END BeginRegis;

(* ----------------------------------------------------------------- *)
PROCEDURE EndRegis;
(* close the current output file *)
BEGIN
  IF output_open THEN
    RegisOff;
    Close( outf );
    output_open := FALSE;
  END;
END EndRegis;

(* ----------------------------------------------------------------- *)
PROCEDURE RegisOn;
(* enter REGIS mode, this is required *)
BEGIN
  IF NOT regis_on THEN
    regis_on := TRUE;
    Output( esc ); Output( 'Pp' );
    EraseScreen;  (* this seems to be required *)
  END;
END RegisOn;

(* ----------------------------------------------------------------- *)
PROCEDURE RegisOff;
(* exit REGIS mode, this is required *)
BEGIN
  IF regis_on THEN
    Output( esc ); Output( '\' );   regis_on := FALSE;
  END;
END RegisOff;

(* ----------------------------------------------------------------- *)
PROCEDURE EraseScreen;
(* erase the whole display *)
BEGIN
  IF output_open THEN
    Output( 'S(E)' );
  END;
END EraseScreen;

(* ----------------------------------------------------------------- *)
PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
(* return the dimensions of the display *)
BEGIN
  columns := max_cols;
  rows    := max_rows;
END GetDimensions;

(* ----------------------------------------------------------------- *)
PROCEDURE GetPosition( VAR column, row :CARDINAL );
(* return the current location of the cursor *)
BEGIN
  column := current_col;
  row    := current_row;
END GetPosition;

(* ----------------------------------------------------------------- *)
PROCEDURE Border;
(* draw a border *)
BEGIN
  IF output_open THEN
    (* move to the corner *)
    Output( 'P[0,' ); OutputNumber( row_offset ); Output( ']' );

    (* output the lines to draw the border, using relative motion *)
    Output( 'V(B)' );
    Output( '[,+' ); OutputNumber( max_rows );
    Output( '[+,' ); OutputNumber( max_cols );
    Output( '[,-' ); OutputNumber( max_rows );
    Output( '(E)' );
  END;
END Border;

(* ----------------------------------------------------------------- *)
PROCEDURE Move( column, row :CARDINAL );
(* move to the new location, make it the current point *)
BEGIN
  IF output_open THEN
    CheckLocation( row, column, current_row, current_col );
    TrueLocation;

    Output( 'P[' );
    OutputNumber( true_col );
    Output( ',' );
    OutputNumber( true_row );
    Output( ']' );
  END;
END Move;

(* ----------------------------------------------------------------- *)
PROCEDURE Dot;
(* draw a dot at the current location *)
BEGIN
  IF output_open THEN
    TrueLocation;

    Output( 'P[' );
    OutputNumber( true_col );
    Output( ',' );
    OutputNumber( true_row );
    Output( ']V[]' );
  END;
END Dot;

(* ----------------------------------------------------------------- *)
PROCEDURE Line( column, row :CARDINAL );
(* draw a line from the current point to the new point *)
BEGIN
  IF output_open THEN
    CheckLocation( row, column, current_row, current_col );
    TrueLocation;

    Output( 'V(S)[' );
    OutputNumber( true_col );
    Output( ',' );
    OutputNumber( true_row );
    Output( '](E)' );
  END;
END Line;

(* ----------------------------------------------------------------- *)
PROCEDURE Circle( radius :CARDINAL; filled :BOOLEAN );
(* draw a circle of the given radius from the current point *)
BEGIN
  IF output_open THEN
    IF radius > biggest THEN radius := biggest; END;

    IF filled THEN Output( 'F(' ); END;

    Output( 'C[+' );
    OutputNumber( radius );
    Output( ']' );

    IF filled THEN Output( ')' ); END;
  END;
END Circle;

(* ----------------------------------------------------------------- *)
PROCEDURE Rectangle( width, height :CARDINAL; filled :BOOLEAN );
(* draw a rectangle, one corner at current point,
   opposite corner at current+width,current+height *)
BEGIN
  IF output_open THEN
    IF width  + current_col > max_cols THEN
      width  := max_cols - current_col; END;
    IF height + current_row > max_rows THEN
      height := max_rows - current_row; END;

    IF filled THEN Output( 'F(' ); END;

    Output( 'V(B)' );
    Output( '[+' );
    OutputNumber( width );
    Output( ']' );
    Output( '[,-' );
    OutputNumber( height );
    Output( ']' );
    Output( '[-' );
    OutputNumber( width );
    Output( ']' );
    Output( '(E)' );

    IF filled THEN Output( ')' ); END;
  END;
END Rectangle;

(* ----------------------------------------------------------------- *)
PROCEDURE Vector( length :CARDINAL; angle :REAL;
                  VAR new_col, new_row :CARDINAL );

VAR
  a, z  :REAL;
  delta :CARDINAL;

  (* ------------------------ *)
  PROCEDURE Delta( length :REAL ) :CARDINAL;
  BEGIN
    length := ABS( length );
    IF length > FLOAT( biggest ) THEN
      RETURN biggest;
    ELSE
      RETURN CARDINAL( TRUNC( length ) );
    END;
  END Delta;

BEGIN

   IF length > biggest THEN
     length := biggest;
   END;

   a := ABS( angle );

   WHILE a >= 360. DO
     a := a - 360.
   END;

   IF angle >= 0. THEN
     angle := a;
   ELSE
     angle := 360. - a;
   END;

   IF ( angle <= 1. ) OR ( angle >= 359. ) THEN
     new_col := current_col + length;
     new_row := current_row;
   ELSE
     IF ( angle >= 89. ) AND ( angle <= 91. ) THEN
       new_row := current_row + length;
       new_col := current_col;
     ELSE
       IF ( angle >= 179. ) AND ( angle <= 181. ) THEN
         IF length >= current_col THEN
           new_col := 0;
         ELSE
           new_col := current_col - length;
         END;
         new_row := current_row;
       ELSE
         IF ( angle >= 269. ) AND ( angle <= 271. ) THEN
           IF length >= current_row THEN
             new_row := 0;
           ELSE
             new_row := current_row - length;
           END;
           new_col := current_col;
         ELSE

           a := angle * 3.141592653 / 180.;

           z := FLOAT( length ) * sin( a );

           IF z >= 0. THEN
             new_row := current_row + Delta(z);
           ELSE
             delta := Delta(z);
             IF delta >= current_row THEN
               new_row := 0;
             ELSE
               new_row := current_row - delta;
             END;
           END;

           z := FLOAT( length ) * cos( a );

           IF z >= 0. THEN
             new_col := current_col + Delta(z);
           ELSE
             delta := Delta(z);
             IF delta >= current_col THEN
               new_col := 0;
             ELSE
               new_col := current_col - delta;
             END;
           END;

         END;
       END;
     END;
   END;

END Vector;

(* ----------------------------------------------------------------- *)
PROCEDURE VectorLine( length :CARDINAL; angle :REAL );
(* draw a line from the current location given a length and angle *)
VAR
  new_row, new_col :CARDINAL;

BEGIN
  IF output_open THEN
    Vector( length, angle, new_col, new_row );
    Line( new_col, new_row );
  END;
END VectorLine;

(* ----------------------------------------------------------------- *)
PROCEDURE VectorMove( length :CARDINAL; angle :REAL );
(* move from the current location given a length and angle *)
VAR
  new_row, new_col :CARDINAL;

BEGIN
  IF output_open THEN
    Vector( length, angle, new_col, new_row );
    Move( new_col, new_row );
  END;
END VectorMove;

(* ----------------------------------------------------------------- *)
PROCEDURE Text( string :ARRAY OF CHAR; size :CARDINAL );
(* put up some text at the current location *)
BEGIN
  IF output_open THEN
    IF size > biggest THEN size := biggest END;

    Output( 'T(S' ); OutputNumber( size ); Output( ')' );
    Output( "'" ); Output( string ); Output( "'" );
  END;
END Text;

(* ----------------------------------------------------------------- *)
PROCEDURE Command( string :ARRAY OF CHAR );
(* put some other REGIS command into the output stream *)
BEGIN
  IF output_open THEN
    Output( string );
  END;
END Command;

BEGIN (* REGISGraphics *)

   current_row := 0; current_col := 0;

   output_open := FALSE;
   regis_on    := FALSE;

   IF absolute_rows > absolute_cols THEN
     biggest := absolute_rows;
   ELSE
     biggest := absolute_cols;
   END;

   FOR i := 0 TO 9 DO
      digits[i] := CHAR( i + 48 );
   END;

END REGISGraphics.