language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/regisgrap.mod
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.