language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/multiscope/vgagraph.mod
IMPLEMENTATION MODULE VGAGraphics;
(*/NOWARN*)
(* simple VGA Graphics routines *)
(* first try at making pc graphics like regis module on the vax *)
(* v1.0, J. Andrea, Apr.12/92 *)
(* This code may be freely used and distributed, it may not be sold. *)
FROM Strings IMPORT Length;
IMPORT Graphics;
CONST
absolute_rows = 480;
absolute_cols = 640;
row_offset = 4;
col_offset = 4;
max_rows = absolute_rows - 2 * row_offset;
max_cols = absolute_cols - 2 * col_offset;
VAR
initial_mode :INTEGER;
current_row, current_col :INTEGER;
vga_on :BOOLEAN;
biggest :CARDINAL;
(* ----------------------------------------------------------------- *)
PROCEDURE BeginVGA;
BEGIN
IF NOT vga_on THEN
Graphics.GetScreenMode( initial_mode );
END;
vga_on := TRUE;
Graphics.ScreenMode( Graphics.gph16CHiRes );
END BeginVGA;
(* ----------------------------------------------------------------- *)
PROCEDURE EndVGA;
BEGIN
IF vga_on THEN
Graphics.ScreenMode( initial_mode );
vga_on := FALSE;
current_row := 0; current_col := 0;
END;
END EndVGA;
(* ----------------------------------------------------------------- *)
PROCEDURE EraseScreen;
BEGIN
IF vga_on THEN
Graphics.ScreenMode( -1 );
END;
END EraseScreen;
(* ----------------------------------------------------------------- *)
PROCEDURE GetDimensions( VAR columns, rows :CARDINAL );
BEGIN
columns := CARDINAL( max_cols );
rows := CARDINAL( max_rows );
END GetDimensions;
(* ----------------------------------------------------------------- *)
PROCEDURE Move( col, row :CARDINAL );
BEGIN
IF vga_on THEN
IF col >= max_cols THEN col := max_cols END;
IF row >= max_rows THEN row := max_rows END;
current_row := INTEGER( row );
current_col := INTEGER( col );
END;
END Move;
(* ----------------------------------------------------------------- *)
PROCEDURE Dot;
BEGIN
DotColor( 14 );
END Dot;
(* ----------------------------------------------------------------- *)
PROCEDURE DotColor( color :CARDINAL );
BEGIN
IF vga_on THEN
Graphics.Dot( col_offset + current_col,
max_rows + row_offset - current_row,
color );
END;
END DotColor;
(* ----------------------------------------------------------------- *)
PROCEDURE Line( col, row :CARDINAL );
BEGIN
LineColor( col, row, 14 );
END Line;
(* ----------------------------------------------------------------- *)
PROCEDURE LineColor( col, row :CARDINAL; color :CARDINAL );
VAR save_row, save_col :INTEGER;
BEGIN
IF vga_on THEN
save_row := current_row;
save_col := current_col;
IF col >= max_cols THEN col := max_cols END;
IF row >= max_rows THEN row := max_rows END;
current_row := INTEGER( row );
current_col := INTEGER( col );
Graphics.Line( col_offset + save_col,
max_rows + row_offset - save_row,
col_offset + current_col,
max_rows + col_offset - current_row,
color );
END;
END LineColor;
(* ----------------------------------------------------------------- *)
PROCEDURE Circle( col, row :CARDINAL; radius :CARDINAL; fill :BOOLEAN );
BEGIN
CircleColor( col, row, radius, 14, fill );
END Circle;
(* ----------------------------------------------------------------- *)
PROCEDURE CircleColor( col, row :CARDINAL; radius :CARDINAL; color :CARDINAL;
fill :BOOLEAN );
BEGIN
IF vga_on THEN
IF col >= max_cols THEN col := max_cols END;
IF row >= max_rows THEN row := max_rows END;
current_row := INTEGER( row );
current_col := INTEGER( col );
Graphics.Circle( col_offset + current_col,
max_rows + row_offset - current_row,
col_offset + current_col,
max_rows + row_offset - current_col - INTEGER( radius ),
color, fill );
END;
END CircleColor;
(* ----------------------------------------------------------------- *)
PROCEDURE Text( string :ARRAY OF CHAR );
BEGIN
TextColor( string, 14 );
END Text;
(* ----------------------------------------------------------------- *)
PROCEDURE TextColor( string :ARRAY OF CHAR; color :CARDINAL );
BEGIN
IF vga_on THEN
Graphics.WriteString( string,
col_offset + current_col,
max_rows + row_offset - current_row,
color, 0, Length( string ) );
END;
END TextColor;
BEGIN
current_row := 0; current_col := 0;
vga_on := FALSE;
IF absolute_rows > absolute_cols THEN
biggest := absolute_rows;
ELSE
biggest := absolute_cols;
END;
END VGAGraphics.