home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pmos2002.zip
/
SRC
/
GWINDOWS.MOD
< prev
next >
Wrap
Text File
|
1996-11-08
|
22KB
|
615 lines
IMPLEMENTATION MODULE GWindows;
(********************************************************)
(* *)
(* Windows module for screen graphics *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 7 November 1996 *)
(* Status: *)
(* Points, lines, and text working. *)
(* Still adding more features. *)
(* Now working on scrolling, setting cursor, etc. *)
(* *)
(********************************************************)
FROM Graphics IMPORT
(* type *) ColourType,
(* proc *) SetMode, SetDefaultMode, GetScreenShape;
FROM Storage IMPORT
(* proc *) ALLOCATE, DEALLOCATE;
FROM ScreenGeometry IMPORT
(* type *) Point, Rectangle,
(* proc *) Inside, TrimLine;
FROM Tiles IMPORT
(* type *) TileSet,
(* proc *) CreateTileSet, DiscardTileSet, AddPoint, AddLine,
AddRectangle, AddString, ClearTileSet, ScrollContents,
AddRotatedString, TileSetMemory;
FROM Keyboard IMPORT
(* proc *) InKey;
FROM FinalExit IMPORT
(* proc *) TerminationMessage;
(************************************************************************)
TYPE
(* A window is described by a record with the following fields. *)
(* absborder the outside edge of the window, in absolute *)
(* (i.e. screen-relative) coordinates. *)
(* databorder the rectangle, in screen-relative coordinates, *)
(* outside which data should not be plotted. *)
(* tiles the set of tiles making up the window. *)
(* background the background colour for the window. *)
(* foreground the foreground colour for the window. *)
(* cursor the text cursor, in terms of points. *)
(* row, column the text cursor, in terms of characters. *)
(* ScrollRegion the "normal" region for text, measured in *)
(* terms of character positions. *)
Window = POINTER TO
RECORD
absborder, databorder: Rectangle;
tiles: TileSet;
background, foreground: ColourType;
cursor: Point;
(* The following fields are in units of characters *)
(* rather than (x,y) coordinates. *)
row, column: INTEGER;
ScrollRegion: Rectangle;
END (*RECORD*);
(************************************************************************)
VAR
(* Maximum screen coordinates and colour for the selected mode. *)
(* (Minimum value is zero in all three cases.) *)
XMAX, YMAX, CharHeight: CARDINAL;
MaxColour: ColourType;
(************************************************************************)
(* OPENING AND CLOSING WINDOWS *)
(************************************************************************)
PROCEDURE DrawFrame (w: Window);
(* Draws the window frame. Used when first opening a window, or *)
(* for putting back the frame after clearing the window. *)
VAR R: Rectangle;
BEGIN
WITH w^ DO
AddRectangle (tiles, absborder, foreground);
IF databorder.left <> absborder.left+1 THEN
R := databorder;
WITH R DO
DEC(left); INC (right);
DEC(bottom); INC (top);
END (*WITH*);
AddRectangle (tiles, R, foreground);
END (*IF*);
END (*WITH*);
END DrawFrame;
(************************************************************************)
PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
left, bottom, right, top: CARDINAL;
Foregrnd, Backgrnd: ColourType;
b: BorderType);
(* Creates a new window. *)
VAR temp: CARDINAL;
BEGIN
(* Make sure that the parameters are within the legal ranges. *)
IF left > XMAX THEN left := XMAX END(*IF*);
IF right > XMAX THEN right := XMAX END(*IF*);
IF left > right THEN
temp := left; left := right; right := temp;
END (*IF*);
IF bottom > YMAX THEN bottom := YMAX END(*IF*);
IF top > YMAX THEN top := YMAX END(*IF*);
IF bottom > top THEN
temp := bottom; bottom := top; top := temp;
END (*IF*);
IF Backgrnd > MaxColour THEN Backgrnd := MaxColour END (*IF*);
IF Foregrnd > MaxColour THEN Foregrnd := MaxColour END (*IF*);
IF Foregrnd = Backgrnd THEN
Foregrnd := (Backgrnd + 1) MOD (MaxColour + 1);
END (*IF*);
NEW (w);
WITH w^ DO
background := Backgrnd; foreground := Foregrnd;
absborder.left := left;
absborder.right := right;
absborder.bottom := bottom;
absborder.top := top;
databorder := absborder;
IF b = double THEN temp := 3
ELSE temp := 1;
END (*IF*);
WITH databorder DO
INC (left, temp); DEC (right, temp);
INC (bottom, temp); DEC (top, temp);
END (*WITH*);
WITH ScrollRegion DO
left := 0; top := 0;
(* The following two lines might need fine tuning. *)
right := (databorder.right - databorder.left) DIV 8 - 1;
bottom := (databorder.top - databorder.bottom)
DIV VAL(INTEGER,CharHeight) - 1;
END (*WITH*);
tiles := CreateTileSet (absborder, background);
END (*WITH*);
DrawFrame (w);
SetCursor (w, 0, 0);
END OpenWindow;
(************************************************************************)
PROCEDURE OpenWindowR (VAR (*OUT*) w: Window; location: Rectangle;
Foregrnd, Backgrnd: ColourType;
b: BorderType);
(* Same as OpenWindow, except for method of specifying location. *)
BEGIN
WITH location DO
IF left < 0 THEN left := 0 END(*IF*);
IF right < 0 THEN right := 0 END(*IF*);
IF bottom < 0 THEN bottom := 0 END(*IF*);
IF top < 0 THEN top := 0 END(*IF*);
OpenWindow (w, left, bottom, right, top, Backgrnd, Foregrnd, b);
END (*WITH*);
END OpenWindowR;
(************************************************************************)
PROCEDURE WindowMemory (w: Window; memory: BOOLEAN);
(* Specifying a FALSE value for the memory parameter means that *)
(* subsequent data sent to this window will be written to the *)
(* screen but not remembered. This saves time and memory, the only *)
(* penalty being that data covered by an overlapping window will *)
(* be lost. Specifying TRUE restores the default condition, where *)
(* all window data are retained for refreshing the screen when *)
(* necessary. *)
BEGIN
TileSetMemory (w^.tiles, memory);
END WindowMemory;
(************************************************************************)
PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
(* Destroys the window. *)
BEGIN
DiscardTileSet (w^.tiles);
DISPOSE (w);
END CloseWindow;
(************************************************************************)
(* CLEARING A WINDOW *)
(************************************************************************)
PROCEDURE ClearWindow (w: Window);
(* Erases all data from w, but keeps it open. *)
BEGIN
ClearTileSet (w^.tiles);
DrawFrame (w); SetCursor (w, 0, 0);
END ClearWindow;
(************************************************************************)
(* SETTING THE FOREGROUND COLOUR *)
(************************************************************************)
PROCEDURE SetColour (w: Window; colour: ColourType);
(* Specifies the foreground colour to be used until further notice. *)
BEGIN
w^.foreground := colour;
END SetColour;
(************************************************************************)
(* PLOTTING A POINT *)
(************************************************************************)
PROCEDURE PutPixelC (w: Window; p: Point; c: ColourType);
(* Plots a dot at the point (x,y) in window w. The coordinates are *)
(* relative to the bottom left of the window. If the dot lies *)
(* outside the window it will be ignored. *)
BEGIN
WITH w^ DO
INC (p.x, absborder.left);
INC (p.y, absborder.bottom);
IF Inside (p.x, p.y, databorder) THEN
AddPoint (tiles, p, c);
END (*WITH*);
END (*WITH*);
END PutPixelC;
(************************************************************************)
PROCEDURE PutPixel (w: Window; p: Point);
(* Plots a dot at the point (x,y) in window w. The coordinates are *)
(* relative to the bottom left of the window. If the dot lies *)
(* outside the window it will be ignored. *)
BEGIN
WITH w^ DO
INC (p.x, absborder.left);
INC (p.y, absborder.bottom);
IF Inside (p.x, p.y, databorder) THEN
AddPoint (tiles, p, foreground);
END (*WITH*);
END (*WITH*);
END PutPixel;
(************************************************************************)
PROCEDURE PutPixel2 (w: Window; x, y: INTEGER);
(* Same as PutPixel, with a different way of specifying the point. *)
VAR p: Point;
BEGIN
p.x := x; p.y := y;
PutPixel (w, p);
END PutPixel2;
(************************************************************************)
PROCEDURE PutPixel2C (w: Window; x, y: INTEGER; colour: ColourType);
(* Same as PutPixel2, with the colour explicitly specified. *)
VAR p: Point;
BEGIN
p.x := x; p.y := y;
PutPixelC (w, p, colour);
END PutPixel2C;
(************************************************************************)
(* DRAWING A STRAIGHT LINE *)
(************************************************************************)
PROCEDURE LineC (w: Window; start, end: Point; colour: ColourType);
(* Draws a straight line. The points are relative to the bottom *)
(* left corner of w. Parts of the line lying outside the window *)
(* are clipped. *)
BEGIN
WITH w^ DO
WITH absborder DO
INC (start.x, left); INC (start.y, bottom);
INC (end.x, left); INC (end.y, bottom);
END (*WITH*);
IF TrimLine (start, end, databorder) THEN
AddLine (tiles, start, end, colour);
END (*IF*);
END (*WITH*);
END LineC;
(************************************************************************)
PROCEDURE Line (w: Window; start, end: Point);
(* Draws a straight line. The points are relative to the bottom *)
(* left corner of w. Parts of the line lying outside the window *)
(* are clipped. *)
BEGIN
LineC (w, start, end, w^.foreground);
END Line;
(************************************************************************)
PROCEDURE Line2 (w: Window; xstart, ystart, xend, yend: INTEGER);
(* The same operation as Line, with a different way of specifying *)
(* the parameters. *)
VAR start, end: Point;
BEGIN
start.x := xstart; start.y := ystart;
end.x := xend; end.y := yend;
Line (w, start, end);
END Line2;
(************************************************************************)
PROCEDURE Line2C (w: Window; xstart, ystart, xend, yend: INTEGER;
colour: ColourType);
(* The same operation as Line2, but with the colour explicitly *)
(* specified. *)
VAR start, end: Point;
BEGIN
start.x := xstart; start.y := ystart;
end.x := xend; end.y := yend;
LineC (w, start, end, colour);
END Line2C;
(************************************************************************)
PROCEDURE StringLength (VAR (*IN*) text: ARRAY OF CHAR): CARDINAL;
(* Finds the true size of the text string, given that there *)
(* could be a nul terminator in the middle. *)
VAR count: CARDINAL;
BEGIN
count := 0;
WHILE (count <= HIGH(text)) AND (text[count] <> CHR(0)) DO
INC (count);
END (*WHILE*);
RETURN count;
END StringLength;
(************************************************************************)
PROCEDURE GString (w: Window; x, y: CARDINAL; text: ARRAY OF CHAR);
(* Writes a horizontal character string at graphics position (x,y) *)
(* relative to window w. Characters which do not fit are not *)
(* displayed. This is not considered to be a text operation since *)
(* the text cursor is not affected and there is no line wrap. *)
VAR count: CARDINAL; place: Point;
BEGIN
count := StringLength (text);
IF count = 0 THEN RETURN END(*IF*);
(* Add the string to the TileSet. *)
WITH w^ DO
place.x := x + VAL(CARDINAL,absborder.left);
place.y := y + VAL(CARDINAL,absborder.bottom);
AddString (tiles, place, text, count, foreground, databorder);
END (*WITH*);
END GString;
(************************************************************************)
PROCEDURE GStringUp (w: Window; x, y: CARDINAL; text: ARRAY OF CHAR);
(* Like GString, but the string is rotated counterclockwise by *)
(* 90 degrees, i.e. it is written in the +Y direction. *)
VAR count: CARDINAL; place: Point;
BEGIN
count := StringLength (text);
IF count = 0 THEN RETURN END(*IF*);
(* Add the string to the TileSet. *)
WITH w^ DO
place.x := x + VAL(CARDINAL,absborder.left);
place.y := y + VAL(CARDINAL,absborder.bottom);
AddRotatedString (tiles, place, text, count, foreground,
databorder);
END (*WITH*);
END GStringUp;
(************************************************************************)
(* TEXT OPERATIONS *)
(************************************************************************)
(* *)
(* Every open window has a "text cursor" which is used only for text *)
(* operations and is independent of any operations on dots and lines. *)
(* The text cursor is updated after any text operation in such a way *)
(* that the characters follow one another in the way one would expect *)
(* for non-graphics windows. *)
(* *)
(************************************************************************)
PROCEDURE ComputeGraphicCursor (w: Window);
(* Converts character position to graphics coordinates in w^.cursor *)
BEGIN
WITH w^ DO
WITH cursor DO
x := databorder.left + 8*column + 3;
y := databorder.top - VAL(INTEGER,CharHeight)*(row+1) - 2;
END (*WITH*);
END (*WITH*);
END ComputeGraphicCursor;
(************************************************************************)
PROCEDURE SetCursor (w: Window; row, column: CARDINAL);
(* Sets the text cursor to the specified row and column. The row *)
(* and column are measured in units of characters (not pixels), *)
(* with (0,0) representing the first character position at the *)
(* upper left of the window. *)
BEGIN
w^.row := row; w^.column := column;
ComputeGraphicCursor (w);
END SetCursor;
(************************************************************************)
PROCEDURE SaveCursor (w: Window; VAR (*OUT*) row, column: CARDINAL);
(* Returns the current row and column of the text cursor. *)
BEGIN
row := w^.row; column := w^.column;
END SaveCursor;
(************************************************************************)
PROCEDURE ScrollUp (w: Window);
(* Moves all the text in w up by one line, discarding what falls *)
(* off the top. *)
BEGIN
ScrollContents (w^.tiles, CharHeight, w^.databorder);
END ScrollUp;
(************************************************************************)
PROCEDURE WriteLn (w: Window);
(* Sets the text cursor to the start of the next text line down. *)
(* If the cursor reaches the bottom of the window, the text in the *)
(* window is scrolled. *)
BEGIN
WITH w^ DO
column := ScrollRegion.left;
IF row >= ScrollRegion.bottom THEN ScrollUp (w)
ELSE INC (row);
END (*IF*);
END (*WITH*);
ComputeGraphicCursor (w);
END WriteLn;
(************************************************************************)
PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
(* Writes a horizontal character string at the current text cursor *)
(* position for window w. Characters which do not fit on the *)
(* current line are wrapped around to a new row. *)
VAR count, amount, pos, j, canfit: CARDINAL;
BEGIN
amount := StringLength (text);
pos := 0;
WITH w^ DO
WITH ScrollRegion DO
IF (amount = 0) OR (right < left) THEN RETURN END(*IF*);
END (*WITH*);
LOOP
IF column > ScrollRegion.right THEN
WriteLn (w);
END (*IF*);
canfit := ScrollRegion.right - column + 1;
IF amount > canfit THEN count := canfit
ELSE count := amount;
END (*IF*);
AddString (tiles, cursor, text, count, foreground, databorder);
INC (column, count); INC (cursor.x, 8*count);
DEC (amount, count);
IF amount = 0 THEN EXIT(*LOOP*) END(*IF*);
WriteLn (w);
INC (pos, count);
FOR j := 0 TO amount-1 DO
text[j] := text[count+j];
END (*FOR*);
END (*LOOP*);
END (*WITH*);
END WriteString;
(************************************************************************)
PROCEDURE WriteChar (w: Window; ch: CHAR);
(* Writes a horizontal character at the current text cursor *)
(* position for window w. The text cursor is updated. *)
VAR buffer: ARRAY [0..0] OF CHAR;
BEGIN
buffer[0] := ch;
WriteString (w, buffer);
END WriteChar;
(************************************************************************)
(* SHUTDOWN *)
(************************************************************************)
PROCEDURE ShutDown;
VAR w: Window; dummy: CHAR;
message: ARRAY [0..79] OF CHAR;
BEGIN
(* For abnormal termination, put an error diagnostic on the *)
(* screen. *)
IF TerminationMessage(message) THEN
OpenWindow (w, 0,0, 300,30, 0, MaxColour, single);
WriteString (w, message);
dummy := InKey();
CloseWindow (w);
END (*IF*);
END ShutDown;
(************************************************************************)
(* INITIALISATION *)
(************************************************************************)
PROCEDURE InitGraphics (mode: CARDINAL);
(* Sets up the Graphics mode. Optional, since the module starts up *)
(* with a best estimate of the "best" mode possible on the *)
(* available hardware. *)
BEGIN
SetMode (mode, TRUE);
GetScreenShape (XMAX, YMAX, MaxColour, CharHeight);
END InitGraphics;
(************************************************************************)
BEGIN
SetDefaultMode;
GetScreenShape (XMAX, YMAX, MaxColour, CharHeight);
FINALLY
ShutDown;
END GWindows.
