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

 
Output of file : JPIGRAPH.MOD contained in archive : M2GRAPH.ZIP
IMPLEMENTATION MODULE BasicGraphics;
(* Simple graphics routines for CGA card
Dave Sewry, modified for JPI Modula-2 by
Robin Roos and Pat Terry, December 1988
For brief specifications see Definition Module *)

FROM SYSTEM IMPORT Registers;
FROM Lib IMPORT Intr;

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 (* JPI extensions used *)
Reg.AX :=0006H;
Intr(Reg, 10H);
END GraphMode;

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

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

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

PROCEDURE CharTabGet (Offset : CARDINAL) : CHAR;
BEGIN (* JPI 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.


  3 Responses to “Category : Modula II Source Code
Archive   : M2GRAPH.ZIP
Filename : JPIGRAPH.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/