Oberon/ETH Oberon/2.3.7/W32.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; (* ET4000W32 ARD/pjm *)
IMPORT Kernel, SYSTEM, Objects;
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;
(* ACL Registers, queued *)
PatAdr = 80H;
SrcAdr = 84H;
PatYOff = 88H;
SrcYOff = 8AH;
DestYOff = 8CH;
BusSize = 8EH;
XYDir = 8FH;
PatWrap = 90H;
SrcWrap = 92H;
XPos = 94H;
YPos = 96H;
XCnt = 98H;
YCnt = 9AH;
RoutCtrl = 9CH;
RelCtrl = 9DH;
BgRop = 9EH;
FgRop = 9FH;
DestAdr = 0A0H;
(* ACL Registers, non-queued *)
SusTerm = 30H;
OpState = 31H;
SyncEn = 32H;
IntMask = 34H;
IntStat = 35H;
AccStat = 36H;
Base = 0BFF00H;
MMU = 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);
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*: INTEGER; (* map hight*)
arrow*, star*, cross*, downArrow*, hook*,
grey0*, grey1*, grey2*, ticks*, solid*: Pattern;
Broadcast*: MsgProc;
dmem, lasty: LONGINT;
pattern: List;
palette: ARRAY 256 OF LONGINT;
clipx, clipy, clipright, cliptop, height, width: LONGINT; (* clipping variables *)
depth: INTEGER;
PROCEDURE max (i, j: LONGINT): LONGINT; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max;
PROCEDURE min (i, j: LONGINT): LONGINT; BEGIN IF i >= j THEN RETURN j ELSE RETURN i END END min;
PROCEDURE Wait;
VAR i: SHORTINT;
BEGIN
REPEAT SYSTEM.GET(Base+AccStat, i) UNTIL ~ODD(i) & ~ODD(i DIV 2);
END Wait;
PROCEDURE Map*(x: LONGINT): LONGINT;
BEGIN RETURN 0A0000H
END Map;
PROCEDURE AdjustClip*(x, y, w, h: LONGINT);
VAR right, top: LONGINT;
BEGIN
right := x + w; top := y + h; clipx := max(clipx, x); clipy := max(clipy, y);
clipright := min(right, clipright); cliptop := min(top, cliptop)
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
clipright := x+w;
cliptop := y+h;
clipy := y; clipx := x
END SetClip;
PROCEDURE GetClip*(VAR x, y, w, h: INTEGER);
BEGIN
x := SHORT(clipx); y := SHORT(clipy); w := SHORT(clipright - clipx); h := SHORT(cliptop - clipy)
END GetClip;
PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT); (* 0 <= col, red, green, blue < 256 *)
VAR ch: CHAR;
BEGIN
palette[col] := ASH(ASH(red, 8) + green, 8) + blue;
IF (col = 0) OR (col = 15) THEN (* either 0 or 15 must be black. set the border to black. *)
(* note: use the palette for the border colour too *)
SYSTEM.PORTIN(3DAH, ch);
SYSTEM.PORTOUT(3C0H, 11X);
IF (red = 0) & (green = 0) & (blue = 0) THEN SYSTEM.PORTOUT(3C0H, CHR(col))
ELSE SYSTEM.PORTOUT(3C0H, CHR(15-col))
END;
SYSTEM.PORTOUT(3C0H, 20X)
END;
SYSTEM.PORTOUT(3C8H, CHR(col));
SYSTEM.PORTOUT(3C9H, CHR(red DIV 4));
SYSTEM.PORTOUT(3C9H, CHR(green DIV 4));
SYSTEM.PORTOUT(3C9H, CHR(blue DIV 4))
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 Dot*(col: Color; x, y, mode: LONGINT);
VAR dest: LONGINT;
BEGIN
IF (y >= clipy) & (y < cliptop) & (x >= clipx) & (x < clipright) THEN
dest := (LONG(Height)-1 - y) * Width + x;
IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X) ELSE SYSTEM.PUT(Base+FgRop, 0CCX) END;
Wait;
SYSTEM.PUT(Base+XCnt, LONG(0));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(Base, dest);
SYSTEM.PUT(MMU, col)
END
END Dot;
PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT);
VAR src, dst, top, right, dX, dY: LONGINT;
BEGIN
right := dx + w; top := dy + h; dX := dx; dY := dy;
IF dx < clipx THEN w := w - (clipx - dx); dx := clipx END;
IF dy < clipy THEN h := h - (clipy - dy); dy := clipy END;
IF clipright < right THEN w := clipright - dx END;
IF cliptop < top THEN h := cliptop - dy END;
IF (w > 0) & (h > 0) THEN
sx := sx - (dX - dx);
sy := sy - (dY - dy);
src := (LONG(Height) - sy - h) * Width + sx;
dst := (LONG(Height) - dy - h) * Width + dx;
IF src # dst THEN
Wait;
SYSTEM.PUT(Base+XCnt, LONG(0));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base+RoutCtrl, 0X);
SYSTEM.PUT(Base+XYDir, 0X);
SYSTEM.PUT(Base+FgRop, 0AAX);
SYSTEM.PUT(Base+SrcAdr, dst);
SYSTEM.PUT(Base+DestAdr, dst);
SYSTEM.PUT(Base+OpState, 9X);
Wait;
SYSTEM.PUT(Base+XCnt, SHORT(w-1));
SYSTEM.PUT(Base+YCnt, SHORT(h-1));
IF dst > src THEN
src := src + w-1 + Width * (h-1);
dst := dst + w-1 + Width * (h-1);
SYSTEM.PUT(Base+XYDir, 3X)
ELSE
SYSTEM.PUT(Base+XYDir, 0X)
END;
SYSTEM.PUT(Base+FgRop, 0CCX);
SYSTEM.PUT(Base+RoutCtrl, 0X);
SYSTEM.PUT(Base+DestAdr, dst);
SYSTEM.PUT(Base+SrcAdr, src);
SYSTEM.PUT(Base+OpState, 9X);
SYSTEM.PUT(Base+XYDir, 0X)
END
END
END CopyBlock;
PROCEDURE SetMode*(x: LONGINT; s: SET);
BEGIN
END SetMode;
PROCEDURE CopyPatternAsm(cpX, cpY, cpW, cpH, pat: LONGINT; VAR buf: ARRAY OF INTEGER);
VAR cpw, cpsw, cph: LONGINT;
CODE {SYSTEM.i386}
MOV EBX,cpW[EBP]
ADD EBX,7
SHR EBX,3
MOV cpw[EBP],EBX ; cpw := cpW DIV 8
MOV ESI,pat[EBP]
XOR EAX,EAX
MOV AL,[ESI]
ADD EAX,7
SHR EAX,3
MOV cpsw[EBP],EAX ; cpsw := p.w DIV 8
MOV EDI,buf[EBP]
MOV EAX,cpW[EBP]
MOV [EDI],AL ; new p.w
INC EDI
MOV EAX,cpH[EBP] ; new p.h
MOV [EDI],AL
INC EDI
MOV EBX,cpsw[EBP]
MOV EAX,cpY[EBP]
IMUL EAX,EBX
ADD ESI,EAX
MOV ECX,cpX[EBP]
SHR ECX,3
ADD ESI,ECX
ADD ESI,2 ; ESI := Sourcepos for Copyloop
MOV cph[EBP],0 ; init loop variables
MOV EDX,cph[EBP]
MOV ECX,cpX[EBP]
AND ECX,7 ; cpX MOD 8
loopcp:
CMP cpH[EBP],EDX
JLE l7cp ; height reached ?
MOV EAX,[ESI]
SHR EAX,CL ; in proper position
PUSH ECX
MOV EBX,-2
MOV ECX,cpW[EBP]
SHL EBX,CL
SHR EBX, 1
NOT EBX
AND EAX,EBX
POP ECX
MOV [EDI],EAX ; copy for a new pattern
MOV EAX,cpsw[EBP]
ADD ESI,EAX ; one line in source up
MOV EAX,cpw[EBP]
ADD EDI,EAX ; one line at destination up
INC EDX
JMP loopcp
l7cp:
END CopyPatternAsm;
PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT);
VAR dest, i: LONGINT;
w, h: CHAR;
lx, ly, cpX, cpY, cpW, cpH, nofbytes: LONGINT;
buf: ARRAY 256 OF INTEGER;
onebyte: CHAR;
doublefill: ARRAY 4 OF CHAR;
BEGIN
SYSTEM.GET(pat, w); SYSTEM.GET(pat+1, h);
cpW := ORD(w) + x; cpH := ORD(h) + y;
lx := x; ly := y;
IF x < clipx THEN x := clipx END;
IF y < clipy THEN y := clipy END;
IF cpW > clipright THEN cpW := clipright END;
IF cpH > cliptop THEN cpH := cliptop END;
cpW := cpW - x; cpH := cpH - y;
cpX := x - lx; cpY := y - ly;
IF (cpW <= 0) OR (cpH <= 0) OR (cpX < 0) OR (cpY < 0) THEN RETURN END;
IF (cpW # ORD(w)) OR (cpH # ORD(h)) THEN
CopyPatternAsm(cpX, cpY, cpW, cpH, pat, buf);
pat := SYSTEM.ADR(buf[0])
END;
dest := (LONG(Height)-1-y) * Width + x;
doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
SYSTEM.GET(pat, w);
SYSTEM.GET(pat+1, h);
INC(pat, 2);
nofbytes := (ORD(w)+7) DIV 8;
Wait;
SYSTEM.PUT(Base+FgRop, 0CCX);
SYSTEM.PUT(Base+XCnt, LONG(3));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base, lasty);
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, doublefill));
Wait;
IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 05AX); SYSTEM.PUT(Base+BgRop, 0AAX)
ELSE SYSTEM.PUT(Base+FgRop, 0F0X); SYSTEM.PUT(Base+BgRop, 0AAX) END;
SYSTEM.PUT(Base+PatAdr, lasty);
SYSTEM.PUT(Base+PatWrap, 2X);
SYSTEM.PUT(Base+XYDir, 2X);
SYSTEM.PUT(Base+YCnt, SHORT(ORD(h)-1));
SYSTEM.PUT(Base+XCnt, SHORT(ORD(w)-1));
SYSTEM.PUT(Base+RoutCtrl, 2X);
SYSTEM.PUT(Base, dest);
SYSTEM.PUT(Base+BusSize, 0X);
FOR i := 0 TO nofbytes*ORD(h)-1 DO SYSTEM.GET(pat+i, onebyte); SYSTEM.PUT(MMU, onebyte) END;
SYSTEM.PUT(Base+BusSize, 2X);
END CopyPattern;
PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT);
VAR dest, right, top: LONGINT;
doublefill: ARRAY 4 OF CHAR;
BEGIN
top := y + h; right := x + w;
IF x < clipx THEN x := clipx END;
IF y < clipy THEN y := clipy END;
IF clipright < right THEN right := clipright END;
IF cliptop < top THEN top := cliptop END;
w := right - x; h := top - y;
IF (w <= 0) OR (h <= 0) OR (x < 0) OR (y < 0) THEN RETURN END;
dest := (Height - y - h) * Width + x;
doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
Wait;
SYSTEM.PUT(Base+FgRop, 0CCX);
SYSTEM.PUT(Base+XCnt, LONG(3));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base, lasty);
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, doublefill));
Wait;
IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X) ELSE SYSTEM.PUT(Base+FgRop, 0CCX) END;
SYSTEM.PUT(Base+SrcWrap, 2X);
SYSTEM.PUT(Base+SrcAdr, lasty);
SYSTEM.PUT(Base+DestAdr, dest);
SYSTEM.PUT(Base+XYDir, 0X);
SYSTEM.PUT(Base+XCnt, SHORT(w-1));
SYSTEM.PUT(Base+YCnt, SHORT(h-1));
SYSTEM.PUT(Base+RoutCtrl, 0X);
SYSTEM.PUT(Base+OpState, 9X);
SYSTEM.PUT(Base+SrcWrap, 0FFX)
END ReplConst;
PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);
VAR dest, vertoff, fourbytes, mod, pw, ph, origh, off, right, top: LONGINT; ch: CHAR;
doublefill: ARRAY 4 OF CHAR;
BEGIN
doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
SYSTEM.GET(pat, ch); pw := ORD(ch);
SYSTEM.GET(pat+1, ch); ph := ORD(ch); origh := ph; INC(pat, 2);
IF (pw # 16) & (pw # 32) THEN RETURN END;
top := y + h; right := x + w;
IF x < clipx THEN x := clipx END;
IF y < clipy THEN y := clipy END;
IF clipright < right THEN right := clipright END;
IF cliptop < top THEN top := cliptop END;
w := right - x; h := top - y;
IF (w <= 0) OR (h <= 0) OR (x < 0) OR (y < 0) THEN RETURN END;
dest := (LONG(Height)-1 - y) * Width + x;
off := (x - px) MOD 32;
vertoff := ((y - py) MOD h) * (w DIV 8);
Wait; (* Foreground color *)
SYSTEM.PUT(Base+FgRop, 0CCX);
SYSTEM.PUT(Base+XCnt, LONG(31));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base, lasty);
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
mod := (w DIV 8)*origh;
Wait;
SYSTEM.PUT(Base+SrcWrap, 5X);
SYSTEM.PUT(Base+PatWrap, 5X);
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base+XYDir, 2X);
SYSTEM.PUT(Base+BgRop, 0CCX);
WHILE h > 0 DO
SYSTEM.GET(pat+vertoff, fourbytes);
IF pw = 16 THEN
vertoff := (vertoff + 2) MOD mod;
fourbytes := fourbytes*10000H + fourbytes MOD 10000H;
ELSE
vertoff := (vertoff + 4) MOD mod
END;
fourbytes := SYSTEM.ROT(fourbytes, -off);
Wait;
SYSTEM.PUT(Base+FgRop, 0F0X);
SYSTEM.PUT(Base+SrcAdr, lasty+32);
SYSTEM.PUT(Base+PatAdr, lasty);
SYSTEM.PUT(Base+XCnt, LONG(31));
SYSTEM.PUT(Base+RoutCtrl, 2X);
SYSTEM.PUT(Base, lasty + 96);
SYSTEM.PUT(MMU, fourbytes);
IF mode = paint THEN
Wait; (* clear color *)
SYSTEM.PUT(Base+FgRop, 0FFX);
SYSTEM.PUT(Base, lasty+64);
SYSTEM.PUT(MMU, fourbytes)
END;
Wait;
IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X)
ELSIF mode = replace THEN SYSTEM.PUT(Base+FgRop, 0CCX)
ELSE
SYSTEM.PUT(Base+PatAdr, lasty+64);
SYSTEM.PUT(Base+FgRop, 0CEX)
END;
SYSTEM.PUT(Base+SrcAdr, lasty+96);
SYSTEM.PUT(Base+XCnt, SHORT(w-1));
SYSTEM.PUT(Base+RoutCtrl, 0X);
SYSTEM.PUT(Base+DestAdr, dest);
SYSTEM.PUT(Base+OpState, 9X);
DEC(h); DEC(dest, LONG(Width))
END;
SYSTEM.PUT(Base+SrcWrap, 0FFX)
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[0]); dest := SYSTEM.ADR(p.pixmap[0]);
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 := pattern; pattern := pl; (* put in list to avoid GC *)
RETURN SYSTEM.ADR(p.w)
END NewPattern;
PROCEDURE CreatePatterns;
VAR image: ARRAY 16 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(11, 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] := -{};
image[2] := -{};
image[3] := -{};
image[4] := -{};
image[5] := -{};
image[6] := -{};
image[7] := -{};
solid := NewPattern(16, 8, 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 src, dst, width, i, base: LONGINT; data: CHAR; mmu: LONGINT;
BEGIN
dst := Width*(LONG(Height)-1-sy) + sx;
SYSTEM.GET(adr+8, width);
SYSTEM.GET(adr+12, base);
src := base + width * dy + dx;
Wait;
SYSTEM.PUT(Base+XCnt, SHORT(w-1));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(Base+XYDir, 0X);
SYSTEM.PUT(Base+BusSize, 0X);
IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X)
ELSE SYSTEM.PUT(Base+FgRop, 0CCX)
END;
mmu := MMU;
WHILE h > 0 DO
Wait;
SYSTEM.PUT(Base, dst);
SYSTEM.MOVE(src,mmu,w);
DEC(dst, LONG(Width)); INC(src, width);
DEC(h)
END;
SYSTEM.PUT(Base+BusSize, 2X)
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 Init;
BEGIN
Wait;
SYSTEM.PUT(Base+13H, 71X);
SYSTEM.PUT(Base+SyncEn, 1X);
SYSTEM.PUT(Base+IntMask, 0X);
SYSTEM.PUT(Base+BusSize, 2X);
SYSTEM.PUT(Base+SrcWrap, 0FFX);
SYSTEM.PUT(Base+RelCtrl, LONG(0));
SYSTEM.PUT(Base+XPos, LONG(0));
SYSTEM.PUT(Base+YPos, LONG(0));
SYSTEM.PUT(Base+SrcYOff, Width-1);
SYSTEM.PUT(Base+DestYOff, Width-1);
SYSTEM.PUT(Base+PatYOff, Width-1);
(* Background color *)
SYSTEM.PUT(Base+FgRop, 0CCX);
SYSTEM.PUT(Base+XCnt, LONG(31));
SYSTEM.PUT(Base+YCnt, LONG(0));
SYSTEM.PUT(Base, lasty+32);
SYSTEM.PUT(Base+RoutCtrl, 1X);
SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
END Init;
PROCEDURE GetVal(str: ARRAY OF CHAR; default: LONGINT): LONGINT;
VAR i: SHORTINT; v, sgn: LONGINT; s: ARRAY 10 OF CHAR;
BEGIN
Kernel.GetConfig(str, s);
IF s[0] = 0X THEN
v := default
ELSE
v := 0; i := 0;
WHILE s[i] # 0X DO v := v*10+(ORD(s[i])-48); INC(i) END
END;
RETURN v
END GetVal;
BEGIN
depth := SHORT(GetVal("Color", 1)); (* assume 1 if not specified *)
IF depth = 0 THEN depth := 1 ELSE depth := 8 END;
Width := SHORT(GetVal("DWidth", 1024)); (* assume 1024 if not specified *)
Height := SHORT(GetVal("DHeight", 768)); (* assume 768 if not specified *)
dmem := GetVal("DMem", 1024)*1024; (* assume 1Mb if not specified *)
UBottom := Height - SHORT(dmem DIV Width) + 1;
Left:= 0; ColLeft:= 0; Bottom:= 0;
lasty := LONG(Height-UBottom)*Width;
pattern := NIL;
Init;
width := Width;
height := Height;
clipx := 0; clipy := UBottom; clipright := width; cliptop := height;
CreatePatterns;
Unit := 10000
END Display.