Category : Modula II Source Code
Archive   : M2GRAPH.ZIP
Filename : STONYGRA.MOD

IMPLEMENTATION MODULE BasicGraphics;
(* Simple graphics routines for CGA card
Dave Sewry, modified for StonyBrook Modula-2 by
Robin Roos and Pat Terry, December 1988
For brief specifications see Definition Module *)

FROM SYSTEM IMPORT REGISTERS, INT;

CONST
CrtBankSeg = 0B000H;
CrtBankOffset = 8000H;
CharTabSeg = 0F000H;
CharTabOffset = 0FA6EH;
MinRow = 0 (* in graphics area *);
MinCol = 0 (* in graphics area *);
MaxRow = 199 (* in graphics area *);
MaxCol = 639 (* in graphics area *);
TYPE
PLOTROUTINE = PROCEDURE (CARDINAL, CARDINAL);
VAR
XMin, YMin, XMax, YMax : REAL (* limits of world window *);
PowerTab : ARRAY [0 .. 7] OF CARDINAL;
CrtBank[0B000H:08000H] : ARRAY [0 .. 16383] OF CHAR;
CharTab[0F000H:0FA6EH] : ARRAY [0..400H] OF CHAR;
Reg : REGISTERS;

PROCEDURE Init;
VAR
Index, Value : CARDINAL;
BEGIN
(* initialise multiplication and division table for shift operations *)
Value := 1;
FOR Index := 0 TO 7 DO
PowerTab[Index] := Value;
Value := Value * 2
END;
END Init;

PROCEDURE GraphMode;
BEGIN (* StonyBrook extensions used *)
Reg.AX :=0006H;
INT(10H, Reg);
END GraphMode;

PROCEDURE TextMode;
BEGIN (* StonyBrook extensions used *)
Reg.AX :=0003H;
INT(10H, Reg)
END TextMode;

PROCEDURE CrtBankGet (Offset : CARDINAL) : CHAR;
BEGIN
RETURN CrtBank[Offset];
END CrtBankGet;

PROCEDURE CrtBankPut (Offset : CARDINAL; CH : CHAR);
BEGIN (* StonyBrook extensions used *)
CrtBank[Offset] := CH;
END CrtBankPut;

PROCEDURE CharTabGet (Offset : CARDINAL) : CHAR;
BEGIN (* StonyBrook extensions used *)
RETURN CharTab[Offset];
END CharTabGet;

PROCEDURE ErasePoint (X, Y : CARDINAL);
VAR
PixelOffset, Value : CARDINAL;
BEGIN
IF (X <= MaxCol) AND (Y <= MaxRow) THEN
(* derive byte offset into CrtBank where pixel X,Y is found *)
PixelOffset := (X DIV 8) + ((Y DIV 2) * 80);
(* odd- or even-numbered row *)
IF ODD(Y) THEN INC(PixelOffset, 8192) END;
(* get actual byte value *)
Value := ORD(CrtBankGet(PixelOffset));
(* if pixel on then switch off (set to zero) else do nothing *)
IF ODD(Value DIV PowerTab[(7 - (X MOD 8))]) THEN
DEC(Value, PowerTab[(7 - (X MOD 8))]);
CrtBankPut(PixelOffset, CHR(Value))
END
END
END ErasePoint;

PROCEDURE PixelOn (X, Y : CARDINAL) : BOOLEAN;
VAR
PixelOffset, Value : CARDINAL;
BEGIN
IF (X > MaxCol) OR (Y > MaxRow) THEN RETURN FALSE END;
(* derive byte offset into CrtBank where pixel X,Y is found *)
PixelOffset := (X DIV 8) + ((Y DIV 2) * 80);
(* odd- or even-numbered row *)
IF ODD(Y) THEN INC(PixelOffset, 8192) END;
(* get actual byte value *)
Value := ORD(CrtBankGet(PixelOffset));
(* if pixel on then return true else return false *)
RETURN ODD(Value DIV PowerTab[(7 - (X MOD 8))])
END PixelOn;

PROCEDURE PlotPoint (X, Y : CARDINAL);
VAR
PixelOffset : CARDINAL;
BEGIN
IF (X <= MaxCol) AND (Y <= MaxRow) THEN
ErasePoint(X, Y);
PixelOffset := (X DIV 8) + ((Y DIV 2) * 80);
IF ODD(Y) THEN INC(PixelOffset, 8192) END;
CrtBankPut(PixelOffset, CHR(ORD(CrtBankGet(PixelOffset)) +
PowerTab[(7 - (X MOD 8))]))
END
END PlotPoint;

PROCEDURE XorPoint (X, Y : CARDINAL);
VAR
PixelOffset : CARDINAL;
BEGIN
IF (X <= MaxCol) AND (Y <= MaxRow) THEN
IF PixelOn(X, Y)
THEN ErasePoint(X, Y)
ELSE PlotPoint(X, Y)
END
END
END XorPoint;

PROCEDURE PlotChar (X, Y : CARDINAL; Letter : CHAR);
(* Write Letter at pixel position X, Y *)
(*
The pixel representation of the Letter is written to the
CrtBank (memory-mapped graphic display).
If the start pixel position is on a byte boundary,
0 1 2 3 4 5 6 7 |8 9 10 11 12 13 14 15
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| | | | | | | | |? |? |? |? |? |? |? |? | CrtBank
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|

+--+--+--+--+--+--+--+--+
|a |b |c |d |e |f |g |h | letter byte
+--+--+--+--+--+--+--+--+

the letter bytes (8 letter bytes to a full Letter) can be
assigned straight-off to the appropriate CrtBank positions.

If the start pixel position is not on a byte boundary,

0 1 2 3 4 5 6 7 |8 9 10 11 12 13 14 15
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|? |? |? |? |? |? |? |? |? |? |? |? |? |? |? |? | CrtBank
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|


+--+--+--+--+--+--+--+--+
|a |b |c |d |e |f |g |h | letter byte
+--+--+--+--+--+--+--+--+

the first affected byte must be shifted right then left and the
letter byte shifted right and then added (all done in
PROCEDURE NewFirstVal)

0 1 2 3 4 5 6 7 |8 9 10 11 12 13 14 15
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|? |? |? |? |? |? |0 |0 |? |? |? |? |? |? |? |? | CrtBank
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|

+--+--+--+--+--+--+--+--+
|0 |0 |0 |0 |0 |0 |a |b | letter byte
+--+--+--+--+--+--+--+--+

the second affected byte must be shifted left and then right
and the letter byte shifted left and then added (all done in
PROCEDURE NewSecondVal)

0 1 2 3 4 5 6 7 |8 9 10 11 12 13 14 15
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|? |? |? |? |? |? |? |? |0 |0 |0 |0 |0 |0 |? |? | CrtBank
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|

+--+--+--+--+--+--+--+--+
|c |d |e |f |g |h |0 |0 | letter byte
+--+--+--+--+--+--+--+--+
*)
VAR
CharOffset, (* Letter offset in CharTab *)
PixOffset, (* byte offset in CrtBank where Pixel resides *)
FirstBase,
SecondBase,
CrtTemp,
CharTemp,
I : CARDINAL;

PROCEDURE NewFirstVal (CrtTemp, CharTemp : CARDINAL) : CARDINAL;
(* Shift the existing contents of the byte in CrtBank (CrtTemp)
and the character to write (CharTemp) so as to clear out
the appropriate bits, and then add *)
BEGIN
(* clear bottom end *)
CrtTemp := CrtTemp DIV PowerTab[(8 - (X MOD 8))];
CrtTemp := CrtTemp * PowerTab[(8 - (X MOD 8))];
(* clear top end *)
CharTemp := CharTemp DIV PowerTab[(X MOD 8)];
RETURN (CrtTemp + CharTemp)
END NewFirstVal;

PROCEDURE NewSecondVal (CrtTemp, CharTemp : CARDINAL) : CARDINAL;
(* shift the existing contents of the byte in CrtBank (CrtTemp)
and the character to write (CharTemp) so as to clear out
the appropriate bits, and then add *)
BEGIN
(* clear top end *)
CrtTemp := ORD(CHR(CrtTemp * PowerTab[(X MOD 8)]));
CrtTemp := CrtTemp DIV PowerTab[(X MOD 8)];
(* clear bottom end *)
CharTemp := ORD(CHR(CharTemp * PowerTab[(8 - (X MOD 8))]));
RETURN (CrtTemp + CharTemp)
END NewSecondVal;

BEGIN
IF (X <= MaxCol) AND (Y <= MaxRow) THEN
CharOffset := ORD(Letter) * 8;
PixOffset := ((X DIV 8) + ((Y DIV 2) * 80));
IF (X MOD 8) = 0
THEN (* pixel on byte boundary *)
IF ODD(Y)
THEN (* odd-numbered row *)
FOR I := 0 TO 3 DO
CrtBankPut((8192 + PixOffset + (I * 80)),
CharTabGet(CharOffset + (I * 2)));
CrtBankPut((PixOffset + ((I + 1) * 80)),
CharTabGet(CharOffset + (I * 2) + 1))
END
ELSE (* even-numbered row *)
FOR I := 0 TO 3 DO
CrtBankPut((PixOffset + (I * 80)),
CharTabGet(CharOffset + (I * 2)));
CrtBankPut((8192 + PixOffset + (I * 80)),
CharTabGet(CharOffset + (I * 2) + 1))
END
END
ELSE (* pixel not on byte boundary *)
IF ODD(Y)
THEN (* odd-numbered row *)
FOR I := 0 TO 3 DO
FirstBase := (8192 + PixOffset + (I * 80));
SecondBase := (PixOffset + ((I + 1) * 80));

CharTemp := ORD(CharTabGet(CharOffset + (I * 2)));

CrtTemp := ORD(CrtBankGet(FirstBase));
CrtBankPut(FirstBase, CHR(NewFirstVal(CrtTemp, CharTemp)));

CrtTemp := ORD(CrtBankGet(FirstBase + 1));
CrtBankPut((FirstBase + 1),
CHR(NewSecondVal(CrtTemp, CharTemp)));

CharTemp := ORD(CharTabGet(CharOffset + (I * 2) + 1));

CrtTemp := ORD(CrtBankGet(SecondBase));
CrtBankPut(SecondBase, CHR(NewFirstVal(CrtTemp, CharTemp)));

CrtTemp := ORD(CrtBankGet(SecondBase + 1));
CrtBankPut((SecondBase + 1),
CHR(NewSecondVal(CrtTemp, CharTemp)))

END
ELSE (* even-numbered row *)
FOR I := 0 TO 3 DO
FirstBase := (PixOffset + (I * 80));
SecondBase := (8192 + FirstBase);

CharTemp := ORD(CharTabGet(CharOffset + (I * 2)));

CrtTemp := ORD(CrtBankGet(FirstBase));
CrtBankPut(FirstBase, CHR(NewFirstVal(CrtTemp, CharTemp)));

CrtTemp := ORD(CrtBankGet(FirstBase +1));
CrtBankPut((FirstBase + 1),
CHR(NewSecondVal(CrtTemp, CharTemp)));

CharTemp := ORD(CharTabGet(CharOffset + (I * 2) + 1));

CrtTemp := ORD(CrtBankGet(SecondBase));
CrtBankPut(SecondBase, CHR(NewFirstVal(CrtTemp, CharTemp)));

CrtTemp := ORD(CrtBankGet(SecondBase + 1));
CrtBankPut((SecondBase + 1),
CHR(NewSecondVal(CrtTemp, CharTemp)))
END
END
END
END
END PlotChar;

PROCEDURE PlotString (X, Y : CARDINAL; Message : ARRAY OF CHAR);
(* Write a string of characters starting at X and StartY *)
VAR
Index : CARDINAL;
BEGIN
Index := 0;
WHILE (Index <= HIGH(Message)) AND (Message[Index] # 0C) DO
PlotChar(X + (Index * 8), Y, Message[Index]); INC(Index)
END
END PlotString;

PROCEDURE LinePlot (X1, Y1, X2, Y2 : INTEGER; Plot : PLOTROUTINE);
VAR
ErrorFactor, Xmove, Ymove, dx, dy : INTEGER;
BEGIN
ErrorFactor := 0;
Xmove := 1;
Ymove := 1;
dx := X2 - X1;
IF dx < 0
THEN
Xmove := -1; dx := -dx
ELSIF dx = 0
THEN ErrorFactor := -1
END;
dy := Y2 - Y1;
IF dy < 0 THEN Ymove := -1; dy := -dy END;
LOOP
IF (X1 >= 0) AND (Y1 >= 0) THEN Plot(X1, Y1) END;
IF (X1 = X2) AND (Y1 = Y2) THEN EXIT END;
IF ErrorFactor < 0
THEN Y1 := Y1 + Ymove; ErrorFactor := ErrorFactor + dx
ELSE X1 := X1 + Xmove; ErrorFactor := ErrorFactor - dy
END
END
END LinePlot;

PROCEDURE PlotLine (X1, Y1, X2, Y2 : INTEGER);
BEGIN
LinePlot(X1, Y1, X2, Y2, PlotPoint)
END PlotLine;

PROCEDURE EraseLine (X1, Y1, X2, Y2 : INTEGER);
BEGIN
LinePlot(X1, Y1, X2, Y2, ErasePoint)
END EraseLine;


PROCEDURE XorLine (X1, Y1, X2, Y2 : INTEGER);
BEGIN
LinePlot(X1, Y1, X2, Y2, XorPoint)
END XorLine;

PROCEDURE Transform (X, Y : REAL; VAR P, Q : CARDINAL);
(* Map X, Y to equivalent point P, Q on screen area. We use
CARDINAL mapping here, and force points out of range to have a
a coordinate greater than MaxCol or MaxRow *)
BEGIN
IF (X >= XMin) AND (X <= XMax)
THEN P := TRUNC(FLOAT(MaxCol) * (X - XMin) / (XMax - XMin) + 0.5)
ELSE P := 2 * MaxCol
END;
IF (Y >= YMin) AND (Y <= YMax)
THEN Q := TRUNC(FLOAT(MaxRow) * (YMax - Y) / (YMax - YMin) + 0.5)
ELSE Q := 2 * MaxRow
END;
END Transform;

PROCEDURE DrawXAxis;
VAR
P, Q : CARDINAL;
BEGIN
IF (YMin <= 0.0) AND (YMax >= 0.0) THEN
Transform(0.0, 0.0, P, Q); PlotLine(MinCol, Q, MaxCol, Q);
END
END DrawXAxis;

PROCEDURE DrawYAxis;
VAR
P, Q : CARDINAL;
BEGIN
IF (XMin <= 0.0) AND (XMax >= 0.0) THEN
Transform(0.0, 0.0, P, Q); PlotLine(P, MinRow, P, MaxRow)
END
END DrawYAxis;

PROCEDURE PlotRealPoint (X, Y : REAL);
VAR
P, Q : CARDINAL;
BEGIN
Transform(X, Y, P, Q); PlotPoint(P, Q)
END PlotRealPoint;

PROCEDURE EraseRealPoint (X, Y : REAL);
VAR
P, Q : CARDINAL;
BEGIN
Transform(X, Y, P, Q); ErasePoint(P, Q)
END EraseRealPoint;

PROCEDURE PlotRealChar (X, Y : REAL; Letter : CHAR);
VAR
P, Q : CARDINAL;
BEGIN
Transform(X, Y, P, Q); PlotChar(P, Q, Letter)
END PlotRealChar;

PROCEDURE PlotRealString (X, Y : REAL; Message : ARRAY OF CHAR);
VAR
P, Q : CARDINAL;
BEGIN
Transform(X, Y, P, Q); PlotString(P, Q, Message)
END PlotRealString;

PROCEDURE PlotRealLine (X1, Y1, X2, Y2 : REAL);
VAR
P1, P2, Q1, Q2 : CARDINAL;
BEGIN
Transform(X1, Y1, P1, Q1);
Transform(X2, Y2, P2, Q2);
IF (P1 <= MaxCol) AND (P2 <= MaxCol) AND (Q1 <= MaxRow) AND (Q2 <= MaxRow)
THEN PlotLine(P1, Q1, P2, Q2)
END
END PlotRealLine;

PROCEDURE EraseRealLine (X1, Y1, X2, Y2 : REAL);
VAR
P1, P2, Q1, Q2 : CARDINAL;
BEGIN
Transform(X1, Y1, P1, Q1);
Transform(X2, Y2, P2, Q2);
IF (P1 <= MaxCol) AND (P2 <= MaxCol) AND (Q1 <= MaxRow) AND (Q2 <= MaxRow)
THEN EraseLine(P1, Q1, P2, Q2)
END
END EraseRealLine;

PROCEDURE DefaultWindow;
BEGIN
XMin := FLOAT(MinCol); YMin := FLOAT(MinRow);
XMax := FLOAT(MaxCol); YMax := FLOAT(MaxRow);
END DefaultWindow;

PROCEDURE SetWindow (MinX, MinY, MaxX, MaxY : REAL);
BEGIN
XMin := MinX; YMin := MinY;
XMax := MaxX; YMax := MaxY;
IF (XMin >= XMax) OR (YMin >= YMax) THEN DefaultWindow END;
GraphMode (* clears screen again *)
END SetWindow;

BEGIN
Init(); DefaultWindow;
(* A useful modification might be to force termination code for TextMode *)
END BasicGraphics.