Oberon/ETH Oberon/2.3.7/GD54xx.Display.Mod
< Oberon | ETH Oberon
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)
MODULE Display;
(* Type: Cirrus Logic 256 Colors
Date: 2. 5. 96
Version: 1.0
Author: Joerg Derungs *)
(* works on 5430, not on 5420 *)
IMPORT SYSTEM, Objects, Kernel;
CONST
BG* = 0; FG* = 15; (*background, foreground*)
replace* = 0; paint* = 1; invert* = 2; (*operation modes*)
remove* = 0; suspend* = 1; restore* = 2; newprinter* = 3; (*ControlMsg id*)
reduce* = 0; extend* = 1; move* = 2; (*ModifyMsg id*)
display* = 0; state* = 1; (*ModifyMsg mode*)
screen* = 0; printer* = 1; (* DisplayMsg device *)
full* = 0; area* = 1; contents* = 2; (* DisplayMsg id. *)
get* = 0; set* = 1; reset* = 2; (*SelectMsg id*)
drop* = 0; integrate* = 1; (*ConsumeMsg id*)
unknown* = 0; index8* = 8; color555* = 16; color565* = 17; color664* = 18; color888* = 24; color8888* = 32;
BitBLTAdr = 0B8000H;
TYPE Color* = LONGINT;
Pattern* = LONGINT;
PatternPtr = POINTER TO RECORD
w, h: CHAR; pixmap: ARRAY 8192 OF CHAR
END;
List = POINTER TO ListDesc;
ListDesc = RECORD
next: List;
pat: PatternPtr
END;
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD (Objects.ObjDesc)
next*, dsc*: Frame;
X*, Y*, W*, H*: INTEGER
END;
FrameMsg* = RECORD (Objects.ObjMsg)
F*: Frame; (*target*)
x*, y*, res*: INTEGER
END;
ControlMsg* = RECORD (FrameMsg)
id*: INTEGER
END;
ModifyMsg* = RECORD (FrameMsg)
id*, mode*: INTEGER;
dX*, dY*, dW*, dH*: INTEGER;
X*, Y*, W*, H*: INTEGER
END;
DisplayMsg* = RECORD (FrameMsg)
device*: INTEGER;
id*: INTEGER;
u*, v*, w*, h*: INTEGER
END;
LocateMsg* = RECORD (FrameMsg)
loc*: Frame;
X*, Y*, u*, v*: INTEGER
END;
SelectMsg* = RECORD (FrameMsg)
id*: INTEGER;
time*: LONGINT;
sel*: Frame;
obj*: Objects.Object
END;
ConsumeMsg* = RECORD (FrameMsg)
id*: INTEGER;
u*, v*: INTEGER;
obj*: Objects.Object
END;
MsgProc* = PROCEDURE (VAR M: FrameMsg);
BitBLTPtr = POINTER TO RECORD
bg : ARRAY 4 OF SHORTINT; (* Background Color for Patterns *)
fg : ARRAY 4 OF SHORTINT; (* Foreground Color for Patterns *)
Width, Height : INTEGER; (* BLT Width & Height *)
DestLen, SrcLen : INTEGER; (* Dest & Src Scanline Length *)
DestLo : INTEGER; DestHi : SHORTINT; (* Dest address *)
SrcLo : INTEGER; SrcHi : SHORTINT; (* Src address *)
Mask : SHORTINT; (* Map Mask *)
Mode, dmy2 : SHORTINT; (* BLT Mode *)
Op : SHORTINT; (* Raster Operation *)
dmy3 : ARRAY 37 OF CHAR;
Start : SHORTINT; (* Start / Reset *)
END;
VAR Unit*: LONGINT; (* RasterUnit = Unit/36000 mm *)
Left*, (* left margin of black-and-white maps *)
ColLeft*, (* left margin of color maps *)
Bottom*, (* bottom of primary map *)
UBottom*, (* bottom of secondary map *)
Width*, (* map width *)
Height*: (* map hight*)
INTEGER;
arrow*, star*, cross*, downArrow*, hook*,
grey0*, grey1*, grey2*, ticks*, solid*: Pattern;
Broadcast*: MsgProc;
Pat: List;
clipx, clipy, clipright, cliptop : INTEGER;
CurBank, patterns, patLo : INTEGER;
patHi : SHORTINT;
PageSize : LONGINT;
DispMem : LONGINT;
depth: INTEGER;
palette: ARRAY 256 OF LONGINT;
PROCEDURE Map*(x: LONGINT): LONGINT;
BEGIN RETURN SYSTEM.VAL (LONGINT, DispMem)
END Map;
PROCEDURE Min (a, b : INTEGER) : INTEGER;
BEGIN IF a < b THEN RETURN a ELSE RETURN b END
END Min;
PROCEDURE Max (a, b : INTEGER) : INTEGER;
BEGIN IF a > b THEN RETURN a ELSE RETURN b END
END Max;
PROCEDURE AdjustClip*(x, y, w, h: LONGINT);
BEGIN
clipx := Max (clipx, SHORT(x)); clipy := Max (clipy, SHORT(y));
clipright := Min (clipright, SHORT(x+w)); cliptop := Min (cliptop, SHORT(y+h));
END AdjustClip;
PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER);
VAR s: CHAR;
BEGIN SYSTEM.GET(pat, s); w := ORD(s); SYSTEM.GET(pat+1, s); h := ORD(s)
END GetDim;
PROCEDURE ResetClip*;
BEGIN clipx := 0; clipy := UBottom; clipright := Width; cliptop := Height
END ResetClip;
PROCEDURE SetClip*(x, y, w, h: LONGINT);
BEGIN
clipx := Max (SHORT(x), 0); clipy := Max (SHORT(y), UBottom);
clipright := Min (SHORT(x+w), Width); cliptop := Min (SHORT(y+h), Height);
END SetClip;
PROCEDURE GetClip*(VAR x, y, w, h: INTEGER);
BEGIN x:= clipx; y:= clipy; w:= clipright-clipx; h:= cliptop-clipy
END GetClip;
PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT); (* 0 <= col, red, green, blue < 256 *)
BEGIN
palette[col] := ASH(ASH(red, 8) + green, 8) + blue;
red := red DIV 4;
green := green DIV 4;
blue := blue DIV 4;
SYSTEM.PORTOUT(3C8H, CHR(col)); (* VGA - write color entry *)
SYSTEM.PORTOUT(3C9H, CHR(red));
SYSTEM.PORTOUT(3C9H, CHR(green));
SYSTEM.PORTOUT(3C9H, CHR(blue))
END SetColor;
PROCEDURE GetColor*(col: Color; VAR red, green, blue: INTEGER);
BEGIN
IF col >= 0 THEN col := palette[col] END;
red := SHORT(ASH(col, -16) MOD 256);
green := SHORT(ASH(col, -8) MOD 256);
blue := SHORT(col MOD 256)
END GetColor;
PROCEDURE RGB*(red, green, blue: LONGINT): Color;
BEGIN
RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue
END RGB;
PROCEDURE -XOR (adr : LONGINT; val : CHAR);
CODE {SYSTEM.i386}
POP EAX
POP EBX
XOR 0[EBX], AL
END XOR;
PROCEDURE Dot*(col: Color; x, y, mode: LONGINT);
VAR Offset : LONGINT; Bank : INTEGER;
BEGIN
IF (y < clipy) OR (x < clipx) OR (y >= cliptop) OR (x >= clipright) THEN RETURN END;
Offset := (Height-y-1)*Width + x;
Bank := SHORT (Offset DIV PageSize);
Offset := Offset MOD PageSize;
IF Bank # CurBank THEN
CurBank := Bank * SHORT(PageSize DIV 4092);
SYSTEM.PORTOUT (03CEH, 09H);
SYSTEM.PORTOUT (03CFH, CHR(CurBank))
END;
IF mode = invert THEN XOR (DispMem+Offset, CHR(col))
ELSE SYSTEM.PUT(DispMem+Offset, CHR(col))
END
END Dot;
PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT);
VAR SourceAddr, DestAddr, delta : LONGINT; BitBLT : BitBLTPtr;
BEGIN
IF dx+w > clipright THEN w := clipright - dx END;
IF dy+h > cliptop THEN h := cliptop - dy END;
IF dx < clipx THEN w := w - (clipx-dx); sx := sx + (clipx-dx); dx := clipx END;
IF dy < clipy THEN h := h - (clipy-dy); sy := sy + (clipy-dy); dy := clipy END;
IF (w <= 0) OR (h <= 0) THEN RETURN END;
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
SourceAddr := (Height-sy-h)*Width + sx;
DestAddr := (Height-dy-h)*Width + dx;
IF DestAddr <= SourceAddr THEN BitBLT.Mode := 0
ELSE
delta := (h-1)*Width + w-1;
SourceAddr := SourceAddr + delta;
DestAddr := DestAddr + delta;
BitBLT.Mode := 1
END;
BitBLT.Width := SHORT(w-1); BitBLT.Height := SHORT(h-1);
BitBLT.DestLo := SHORT (DestAddr MOD (256*256)); BitBLT.DestHi := SHORT (SHORT (DestAddr DIV (256*256)));
BitBLT.SrcLo := SHORT (SourceAddr MOD (256*256)); BitBLT.SrcHi := SHORT (SHORT (SourceAddr DIV (256*256)));
IF mode < 2 THEN BitBLT.Op := 0DH ELSE BitBLT.Op := 59H END; BitBLT.Start := 2;
REPEAT UNTIL (BitBLT.Start MOD 2 = 0);
END CopyBlock;
PROCEDURE SetMode*(x: LONGINT; s: SET);
BEGIN
END SetMode;
PROCEDURE ReversePattern (pat, dest : LONGINT; len, minw, maxw, minh, maxh : INTEGER);
VAR a, b : INTEGER;
i, j, k, outlen : INTEGER;
BEGIN
pat := pat+2+len*(maxh-1);
outlen := (maxw-minw+7) DIV 8;
FOR k := minh TO maxh-1 DO
i := minw; a := 0; SYSTEM.GET(pat + i DIV 8, SYSTEM.VAL(CHAR, a));
IF i MOD 8 # 0 THEN FOR j := 1 TO i MOD 8 DO a := a DIV 2 END END;
j := 0; b := 0;
REPEAT b := b*2 + a MOD 2; a := a DIV 2;
INC (i); IF i MOD 8 = 0 THEN SYSTEM.GET(pat + i DIV 8, SYSTEM.VAL(CHAR, a)) END;
IF j MOD 8 = 7 THEN SYSTEM.PUT(dest + j DIV 8, CHR(b)); b := 0 END; INC (j)
UNTIL j = outlen*8;
SYSTEM.PUT(dest + j DIV 8, CHR(b));
pat := pat - len; dest := dest + outlen
END;
END ReversePattern;
PROCEDURE CopyPattern* (col: Color; pat: Pattern; x, y, mode: LONGINT);
VAR k : INTEGER;
w, h, len : INTEGER;
dst : LONGINT;
minh, maxh, minw, maxw : INTEGER;
BitBLT : BitBLTPtr;
BEGIN
GetDim (pat, w, h);
len := (w+7) DIV 8;
minh := 0; maxh := h; minw := 0; maxw := w;
IF x < clipx THEN minw := SHORT(clipx-x) END;
IF x+w > clipright THEN maxw := SHORT(clipright-x) END;
IF y < clipy THEN minh := SHORT(clipy-y) END;
IF y+h > cliptop THEN maxh := SHORT(cliptop-y) END;
IF (minh >= maxh) OR (minw >= maxw) THEN RETURN END;
IF CurBank # patterns THEN
CurBank := patterns;
SYSTEM.PORTOUT (03CEH, 09H);
SYSTEM.PORTOUT (03CFH, CHR(CurBank))
END;
ReversePattern (pat, 0A0000H, len, minw, maxw, minh, maxh);
dst := (Height-y-maxh)*Width + x + minw;
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
FOR k := 0 TO 3 DO BitBLT.fg[k] := SYSTEM.VAL (SHORTINT, col) END;
IF mode = replace THEN col := BG ELSE col := -col-1 END;
FOR k := 0 TO 3 DO BitBLT.bg[k] := SYSTEM.VAL(SHORTINT, col) END;
BitBLT.Width := maxw-minw-1; BitBLT.Height := maxh-minh-1;
BitBLT.DestLo := SYSTEM.VAL (INTEGER, dst); BitBLT.DestHi := SHORT (SHORT (dst DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
IF mode = replace THEN BitBLT.Mode := SYSTEM.VAL (SHORTINT, 80H)
ELSE BitBLT.Mode := SYSTEM.VAL (SHORTINT, 88H) END;
IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END CopyPattern;
PROCEDURE ReplConst* (col: Color; x, y, w, h, mode: LONGINT);
VAR fill : SET; dest : LONGINT; BitBLT : BitBLTPtr;
BEGIN
IF x < clipx THEN w := w - (clipx-x); x := clipx END;
IF y < clipy THEN h := h - (clipy-y); y := clipy END;
IF x+w > clipright THEN w := clipright-x END;
IF y+h > cliptop THEN h := cliptop-y END;
IF (h <= 0) OR (w <= 0) THEN RETURN END;
IF CurBank # patterns THEN
CurBank := patterns;
SYSTEM.PORTOUT (03CEH, 09H);
SYSTEM.PORTOUT (03CFH, CHR(patterns))
END;
fill := {0..31};
SYSTEM.PUT(0A0000H, fill);
SYSTEM.PUT(0A0004H, fill);
dest := (Height-y-h)*Width + x;
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
BitBLT.fg[0] := SYSTEM.VAL(SHORTINT, col);
BitBLT.Width := SHORT(w-1); BitBLT.Height := SHORT(h-1);
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Mode := SYSTEM.VAL (SHORTINT, 0C0H);
IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0
END ReplConst;
PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);
VAR dh, dw, pw, ph, len, rw, rh : INTEGER;
row, dest : LONGINT;
i, j : INTEGER;
bcol : INTEGER;
BitBLT : BitBLTPtr;
BEGIN
IF x < clipx THEN w := w - (clipx-x); x := clipx END;
IF y < clipy THEN h := h - (clipy-y); y := clipy END;
IF x+w > clipright THEN w := clipright-x END;
IF y+h > cliptop THEN h := cliptop-y END;
IF (h <= 0) OR (w <= 0) THEN RETURN END;
IF CurBank # patterns THEN
CurBank := patterns;
SYSTEM.PORTOUT (03CEH, 09H);
SYSTEM.PORTOUT (03CFH, SYSTEM.VAL (CHAR, CurBank))
END;
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
GetDim (pat, pw, ph); len := (pw+7) DIV 8;
dw := pw - (pw + SHORT(x-px) MOD pw) MOD pw;
dh := ph - (ph + SHORT(y-py) MOD ph) MOD ph;
FOR i := 0 TO 3 DO BitBLT.fg[i] := SYSTEM.VAL(SHORTINT, col) END;
IF mode = replace THEN bcol := BG ELSE bcol := SHORT(-col-1) END;
FOR i := 0 TO 3 DO BitBLT.bg[i] := SHORT(bcol) END;
IF mode = replace THEN BitBLT.Mode := SYSTEM.VAL (SHORTINT, 80H)
ELSE BitBLT.Mode := SYSTEM.VAL (SHORTINT, 88H) END;
IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END;
IF dh > h THEN ph := ph-SHORT(dh-h); dh := SHORT(h) END;
IF dw > w THEN pw := pw-SHORT(dw-w); dw := SHORT(w) END;
w := w-dw; h := h-dh; y := y+dh;
IF (dh > 0) & (w > 0) THEN (* lower row *)
ReversePattern (pat, 0A0000H, len, 0, pw, ph-dh, ph);
BitBLT.Width := pw-1; BitBLT.Height := dh-1;
dest := (Height-y)*Width + x+dw;
FOR i := 1 TO SHORT(w) DIV pw DO
BitBLT.DestLo := SYSTEM.VAL (INTEGER, dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
dest := dest + pw;
END;
rw := SHORT(w) MOD pw;
IF rw > 0 THEN
ReversePattern (pat, 0A0000H, len, 0, rw, ph-dh, ph);
BitBLT.Width := rw-1;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
END;
IF (dw > 0) & (h > 0) THEN (* left column *)
ReversePattern (pat, 0A0000H, len, pw-dw, pw, 0, ph);
BitBLT.Width := dw-1; BitBLT.Height := ph-1;
dest := (Height-y)*Width + x;
FOR i := 1 TO SHORT(h) DIV ph DO
dest := dest - LONG(Width)*ph;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
rh := SHORT(h) MOD ph;
IF rh > 0 THEN
ReversePattern (pat, 0A0000H, len, pw-dw, pw, 0, rh);
BitBLT.Height := rh-1;
dest := dest - LONG(Width)*rh;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
END;
IF (dw > 0) & (dh > 0) THEN (* bottom left corner *)
ReversePattern (pat, 0A0000H, len, pw-dw, pw, ph-dh, ph);
BitBLT.Width := dw-1; BitBLT.Height := dh-1;
dest := (Height-y)*Width + x;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
x := x+dw;
ReversePattern (pat, 0A0000H, len, 0, pw, 0, ph); (* easy rectangle *) (*********************************)
row := (Height-y)*Width + x;
BitBLT.Width := pw-1; BitBLT.Height := ph-1;
FOR i := 1 TO SHORT(w) DIV pw DO
dest := row;
FOR j := 1 TO SHORT(h) DIV ph DO
dest := dest - LONG(Width)*ph;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
row := row+pw;
END;
rh := SHORT(h) MOD ph;
IF rh > 0 THEN (* top line *)
BitBLT.Height := rh-1;
SYSTEM.MOVE (0A0000H + (ph-rh)*len, 0A0000H, rh*len);
dest := (Height-y-h)*Width + x;
FOR i := 1 TO SHORT(w) DIV pw DO
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
dest := dest + pw
END;
END;
rw := SHORT(w) MOD pw;
IF rw > 0 THEN (* last column *)
ReversePattern (pat, 0A0000H, len, 0, rw, 0, ph);
BitBLT.Width := rw-1; BitBLT.Height := ph-1;
dest := (Height-y)*Width + x+w-rw;
FOR i := 1 TO SHORT(h) DIV ph DO
dest := dest - LONG(Width)*ph;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END;
IF rh > 0 THEN
BitBLT.Height := rh-1;
SYSTEM.MOVE (0A0000H + (ph-rh)*((rw+7) DIV 8), 0A0000H, rh*((rw+7) DIV 8));
dest := dest - LONG(Width)*rh;
BitBLT.DestLo := SHORT (dest); BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256)));
BitBLT.SrcLo := patLo; BitBLT.SrcHi := patHi;
BitBLT.Start := 2;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
END
END
END FillPattern;
PROCEDURE ReplPattern*(col: Color; pat: Pattern; x, y, w, h, mode: LONGINT);
BEGIN
FillPattern (col, pat, 0, 0, x, y, w, h, mode)
END ReplPattern;
PROCEDURE NewPattern*(w, h: LONGINT; VAR image: ARRAY OF SET): Pattern;
VAR len, src, dest, i: LONGINT; p: PatternPtr; pl: List;
BEGIN
len := (w+7) DIV 8;
SYSTEM.NEW(p, 4+len*h); p.w := CHR(w); p.h := CHR(h);
src := SYSTEM.ADR(image); dest := SYSTEM.ADR(p.pixmap);
i := 0;
WHILE i < h DO SYSTEM.MOVE(src, dest, len); INC(src, 4); INC(dest, len); INC(i) END;
NEW(pl); pl.pat := p; pl.next := Pat; Pat := pl; (* put in list to avoid GC *)
RETURN SYSTEM.ADR(p.w)
END NewPattern;
PROCEDURE CreatePatterns;
VAR image: ARRAY 256 OF SET;
BEGIN
image[0] := {13};
image[1] := {12..14};
image[2] := {11..13};
image[3] := {10..12};
image[4] := {9..11};
image[5] := {8..10};
image[6] := {7..9};
image[7] := {0, 6..8};
image[8] := {0, 1, 5..7};
image[9] := {0..2, 4..6};
image[10] := {0..5};
image[11] := {0..4};
image[12] := {0..5};
image[13] := {0..6};
image[14] := {0..7};
arrow := NewPattern(15, 15, image);
image[0] := {0, 10};
image[1] := {1, 9};
image[2] := {2, 8};
image[3] := {3, 7};
image[4] := {4, 6};
image[5] := {};
image[6] := {4, 6};
image[7] := {3, 7};
image[8] := {2, 8};
image[9] := {1, 9};
image[10] := {0, 10};
cross := NewPattern(11, 11, image);
image[0] := {6};
image[1] := {5..7};
image[2] := {4..8};
image[3] := {3..9};
image[4] := {2..10};
image[5] := {5..7};
image[6] := {5..7};
image[7] := {5..7};
image[8] := {5..7};
image[9] := {5..7};
image[10] := {5..7};
image[11] := {5..7};
image[12] := {5..7};
image[13] := {5..7};
image[14] := {};
downArrow := NewPattern(15, 15, image);
image[0] := {0, 4, 8, 12};
image[1] := {};
image[2] := {2, 6, 10, 14};
image[3] := {};
image[4] := {0, 4, 8, 12};
image[5] := {};
image[6] := {2, 6, 10, 14};
image[7] := {};
image[8] := {0, 4, 8, 12};
image[9] := {};
image[10] := {2, 6, 10, 14};
image[11] := {};
image[12] := {0, 4, 8, 12};
image[13] := {};
image[14] := {2, 6, 10, 14};
image[15] := {};
grey0 := NewPattern(16, 16, image);
image[0] := {0, 2, 4, 6, 8, 10, 12, 14};
image[1] := {1, 3, 5, 7, 9, 11, 13, 15};
image[2] := {0, 2, 4, 6, 8, 10, 12, 14};
image[3] := {1, 3, 5, 7, 9, 11, 13, 15};
image[4] := {0, 2, 4, 6, 8, 10, 12, 14};
image[5] := {1, 3, 5, 7, 9, 11, 13, 15};
image[6] := {0, 2, 4, 6, 8, 10, 12, 14};
image[7] := {1, 3, 5, 7, 9, 11, 13, 15};
image[8] := {0, 2, 4, 6, 8, 10, 12, 14};
image[9] := {1, 3, 5, 7, 9, 11, 13, 15};
image[10] := {0, 2, 4, 6, 8, 10, 12, 14};
image[11] := {1, 3, 5, 7, 9, 11, 13, 15};
image[12] := {0, 2, 4, 6, 8, 10, 12, 14};
image[13] := {1, 3, 5, 7, 9, 11, 13, 15};
image[14] := {0, 2, 4, 6, 8, 10, 12, 14};
image[15] := {1, 3, 5, 7, 9, 11, 13, 15};
grey1 := NewPattern(16, 16, image);
image[0] := {0, 1, 4, 5, 8, 9, 12, 13};
image[1] := {0, 1, 4, 5, 8, 9, 12, 13};
image[2] := {2, 3, 6, 7, 10, 11, 14, 15};
image[3] := {2, 3, 6, 7, 10, 11, 14, 15};
image[4] := {0, 1, 4, 5, 8, 9, 12, 13};
image[5] := {0, 1, 4, 5, 8, 9, 12, 13};
image[6] := {2, 3, 6, 7, 10, 11, 14, 15};
image[7] := {2, 3, 6, 7, 10, 11, 14, 15};
image[8] := {0, 1, 4, 5, 8, 9, 12, 13};
image[9] := {0, 1, 4, 5, 8, 9, 12, 13};
image[10] := {2, 3, 6, 7, 10, 11, 14, 15};
image[11] := {2, 3, 6, 7, 10, 11, 14, 15};
image[12] := {0, 1, 4, 5, 8, 9, 12, 13};
image[13] := {0, 1, 4, 5, 8, 9, 12, 13};
image[14] := {2, 3, 6, 7, 10, 11, 14, 15};
image[15] := {2, 3, 6, 7, 10, 11, 14, 15};
grey2 := NewPattern(16, 16, image);
image[0] := {0..2, 8..11};
image[1] := {0..2, 7..10};
image[2] := {0..2, 6..9};
image[3] := {0..2, 5..8};
image[4] := {0..2, 4..7};
image[5] := {0..6};
image[6] := {0..5};
image[7] := {0..4};
image[8] := {0..3};
image[9] := {0..2};
image[10] := {0, 1};
image[11] := {0};
hook:= NewPattern(12, 12, image);
image[0] := {7};
image[1] := {7};
image[2] := {2, 7, 12};
image[3] := {3, 7, 11};
image[4] := {4, 7, 10};
image[5] := {5, 7, 9};
image[6] := {6..8};
image[7] := {0..6, 8..14};
image[8] := {6..8};
image[9] := {5, 7, 9};
image[10] := {4, 7, 10};
image[11] := {3, 7, 11};
image[12] := {2, 7, 12};
image[13] := {7};
image[14] := {7};
star := NewPattern(15, 15, image);
image[0] := {};
image[1] := {};
image[2] := {0};
image[3] := {};
image[4] := {};
image[5] := {};
image[6] := {};
image[7] := {};
image[8] := {};
image[9] := {};
image[10] := {};
image[11] := {};
image[12] := {};
image[13] := {};
image[14] := {};
image[15] := {};
ticks := NewPattern(16, 16, image);
image[0] := -{};
image[1] := -{};
solid := NewPattern(16, 2, image);
END CreatePatterns;
PROCEDURE Depth*(x: LONGINT): INTEGER;
BEGIN
RETURN depth
END Depth;
PROCEDURE TrueColor*(x: LONGINT): BOOLEAN;
BEGIN
RETURN FALSE
END TrueColor;
PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT);
VAR BlockLen : LONGINT;
Source, Dest : LONGINT;
i, j, len : INTEGER;
Screen, Block, Temp : LONGINT;
BitBLT : BitBLTPtr;
BEGIN
BlockLen := 0;
SYSTEM.GET(adr+8, BlockLen);
len := SHORT(w+3) DIV 4;
SYSTEM.GET(adr+12, Source);
Source := Source + dy*BlockLen + dx;
Dest := (Height-sy-1)*Width + sx;
Screen := 0A0000H;
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
BitBLT.Width := SHORT(w-1); BitBLT.Height := 0;
BitBLT.Mode := 4;
IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END;
FOR i := 0 TO SHORT(h-1) DO
Block := Source;
BitBLT.DestLo := SYSTEM.VAL (INTEGER, Dest);
BitBLT.DestHi := SHORT (SHORT (Dest DIV (256*256)));
BitBLT.Start := 2;
FOR j := 0 TO (len-1)*4 BY 4 DO
SYSTEM.GET(Block+j, Temp);
SYSTEM.PUT(Screen+j, Temp)
END;
REPEAT UNTIL BitBLT.Start MOD 2 = 0;
Dest := Dest-Width; Source := Source+BlockLen;
END;
END DisplayBlock;
PROCEDURE TransferFormat*(x: LONGINT): LONGINT;
BEGIN
RETURN unknown
END TransferFormat;
PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT);
BEGIN
HALT(99)
END TransferBlock;
PROCEDURE InitRegister;
CODE {SYSTEM.i386}
MOV AX, 0017H ; map BLT engine to 0B8000H
MOV DX, 03C4H
OUT DX, AL
MOV DX, 03C5H
IN AL, DX ; GD5430 - map BitBLT to memory
OR AX, 0044H
OUT DX, AL
MOV DispMem, 0A0000H
MOV EBX, BitBLTAdr ; reset BLT engine
MOV AX, 4
MOV 40H[EBX], AL
END InitRegister;
PROCEDURE InitBitBLT;
VAR BitBLT: BitBLTPtr;
BEGIN
BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr);
BitBLT.DestLen := Width; BitBLT.SrcLen := Width;
BitBLT.Mask := 0
END InitBitBLT;
(* StrToInt - Convert a string to an integer *)
PROCEDURE StrToInt(VAR i: LONGINT; VAR s: ARRAY OF CHAR): LONGINT;
VAR vd, vh, sgn, d: LONGINT; hex: BOOLEAN;
BEGIN
vd := 0; vh := 0; hex := FALSE;
IF s[i] = "-" THEN sgn := -1; INC(i) ELSE sgn := 1 END;
LOOP
IF (s[i] >= "0") & (s[i] <= "9") THEN d := ORD(s[i])-ORD("0")
ELSIF (CAP(s[i]) >= "A") & (CAP(s[i]) <= "F") THEN d := ORD(CAP(s[i]))-ORD("A")+10; hex := TRUE
ELSE EXIT
END;
vd := 10*vd + d; vh := 16*vh + d;
INC(i)
END;
IF CAP(s[i]) = "H" THEN hex := TRUE; INC(i) END; (* optional H *)
IF hex THEN vd := vh END;
RETURN sgn * vd
END StrToInt;
(* GetVal - Get config string and convert to integer. *)
PROCEDURE GetVal(name: ARRAY OF CHAR; default: LONGINT): LONGINT;
VAR v: LONGINT; s: ARRAY 10 OF CHAR; p: LONGINT;
BEGIN
Kernel.GetConfig(name, s);
IF s[0] = 0X THEN
v := default
ELSE
p := 0; v := StrToInt(p, s)
END;
RETURN v
END GetVal;
PROCEDURE Init;
CONST PatSize = 64*1024;
VAR mem: LONGINT;
BEGIN
Width := SHORT(GetVal("DWidth", 1024)); (* assume 1024 if not specified *)
Height := SHORT(GetVal("DHeight", 768)); (* assume 768 if not specified *)
IF GetVal("Color", 1) = 0 THEN depth := 1 ELSE depth := 8 END;
mem := GetVal("DMem", 0)*1024;
IF mem = 0 THEN (* compute default *)
mem := 512*1024;
WHILE LONG(Width)*Height >= mem DO mem := mem*2 END
END;
DEC(mem, PatSize); (* reserve space for patterns *)
UBottom := SHORT(Height - mem DIV Width);
patterns := SHORT(mem DIV 4096); (* page number of patterns *)
patHi := SHORT(SHORT(mem DIV 10000H));
patLo := SHORT(mem MOD 10000H)
END Init;
BEGIN
Init;
Left:= 0; ColLeft:= 0; Bottom:= 0;
Pat := NIL;
ResetClip;
CreatePatterns;
Unit := 10000;
CurBank:= patterns;
SYSTEM.PORTOUT (03CEH, 09H);
SYSTEM.PORTOUT (03CFH, CHR(CurBank));
PageSize := 256 * 256;
InitRegister;
InitBitBLT;
ReplConst(1, Width DIV 2, Height DIV 2, Width DIV 2, Height DIV 2, replace);
END Display.
Compiler.Compile GD54xx.Display.Mod\X ~