Oberon/ETH Oberon/2.3.7/Trace.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;
(* Native Oberon trace display driver, 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;
TYPE Color* = LONGINT;
Pattern* = LONGINT;
PatternPtr = POINTER TO RECORD w, h, pixmap: SHORTINT 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*: (* map hight*)
INTEGER;
arrow*, star*, cross*, downArrow*, hook*: Pattern;
grey0*, grey1*, grey2*, ticks*, solid*: Pattern;
Broadcast*: MsgProc;
Pat: List;
PROCEDURE Map*(x: LONGINT): LONGINT;
BEGIN
Kernel.WriteString("Map("); Kernel.WriteInt(x, 1); Kernel.WriteString(") ");
RETURN 0
END Map;
PROCEDURE AdjustClip*(x, y, w, h: LONGINT);
BEGIN
Kernel.WriteString("AdjustClip("); Kernel.WriteInt(x, 1); Kernel.WriteChar(",");
Kernel.WriteInt(y, 1); Kernel.WriteChar(","); Kernel.WriteInt(w, 1);
Kernel.WriteChar(","); Kernel.WriteInt(h, 1); Kernel.WriteString(") ")
END AdjustClip;
PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER);
VAR s: SHORTINT;
BEGIN SYSTEM.GET(pat, s); w := s; SYSTEM.GET(pat+1, s); h := s;
Kernel.WriteString("GetDim("); Kernel.WriteHex(pat, 8); Kernel.WriteString(") ")
END GetDim;
PROCEDURE ResetClip*;
BEGIN
Kernel.WriteString("ResetClip ")
END ResetClip;
PROCEDURE SetClip*(x, y, w, h: LONGINT);
BEGIN
Kernel.WriteString("SetClip("); Kernel.WriteInt(x, 1); Kernel.WriteChar(",");
Kernel.WriteInt(y, 1); Kernel.WriteChar(","); Kernel.WriteInt(w, 1);
Kernel.WriteChar(","); Kernel.WriteInt(h, 1); Kernel.WriteString(") ")
END SetClip;
PROCEDURE GetClip*(VAR x, y, w, h: INTEGER);
BEGIN
Kernel.WriteString("GetClip ");
x := 0; y := 0; w := Width; h := Height
END GetClip;
PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT); (* 0 <= col, red, green, blue < 256 *)
BEGIN
Kernel.WriteString("SetColor("); Kernel.WriteInt(col, 1); Kernel.WriteChar(",");
Kernel.WriteInt(red, 1); Kernel.WriteChar(","); Kernel.WriteInt(green, 1); Kernel.WriteChar(",");
Kernel.WriteInt(blue, 1); Kernel.WriteString(") ")
END SetColor;
PROCEDURE GetColor*(col: Color; VAR red, green, blue: INTEGER);
BEGIN
Kernel.WriteString("GetColor("); Kernel.WriteInt(col, 1); Kernel.WriteString(") ");
IF col < 0 THEN
red := SHORT(ASH(col, -16) MOD 256);
green := SHORT(ASH(col, -8) MOD 256);
blue := SHORT(col MOD 256)
ELSE
red := 0; green := 0; blue := 0
END
END GetColor;
PROCEDURE RGB*(red, green, blue: LONGINT): Color;
BEGIN
Kernel.WriteString("RGB("); Kernel.WriteInt(red, 1); Kernel.WriteChar(",");
Kernel.WriteInt(green, 1); Kernel.WriteChar(","); Kernel.WriteInt(blue, 1);
Kernel.WriteString(") ");
RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue
END RGB;
PROCEDURE Dot*(col: Color; x, y, mode: LONGINT);
BEGIN
Kernel.WriteString("Dot("); Kernel.WriteInt(col, 1); Kernel.WriteChar(",");
Kernel.WriteInt(x, 1); Kernel.WriteChar(","); Kernel.WriteInt(y, 1); Kernel.WriteChar(",");
Kernel.WriteInt(mode, 1); Kernel.WriteString(") ")
END Dot;
PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT);
BEGIN
Kernel.WriteString("CopyBlock("); Kernel.WriteInt(sx, 1); Kernel.WriteChar(",");
Kernel.WriteInt(sy, 1); Kernel.WriteChar(","); Kernel.WriteInt(w, 1); Kernel.WriteChar(",");
Kernel.WriteInt(h, 1); Kernel.WriteChar(","); Kernel.WriteInt(dx, 1); Kernel.WriteChar(",");
Kernel.WriteInt(dy, 1); Kernel.WriteChar(","); Kernel.WriteInt(mode, 1); Kernel.WriteString(") ")
END CopyBlock;
PROCEDURE SetMode*(x: LONGINT; s: SET);
BEGIN
Kernel.WriteString("SetMode("); Kernel.WriteInt(x, 1); Kernel.WriteChar(",");
Kernel.WriteHex(SYSTEM.VAL(LONGINT, s), 8); Kernel.WriteString(") ")
END SetMode;
PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT);
BEGIN
Kernel.WriteString("CopyPattern("); Kernel.WriteInt(col, 1); Kernel.WriteChar(",");
Kernel.WriteHex(pat, 8); Kernel.WriteChar(","); Kernel.WriteInt(x, 1); Kernel.WriteChar(",");
Kernel.WriteInt(y, 1); Kernel.WriteChar(","); Kernel.WriteInt(mode, 1); Kernel.WriteString(") ")
END CopyPattern;
PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); (* col not used if mode is invert *)
BEGIN
Kernel.WriteString("ReplConst("); Kernel.WriteInt(col, 1); Kernel.WriteChar(",");
Kernel.WriteInt(x, 1); Kernel.WriteChar(","); Kernel.WriteInt(y, 1);
Kernel.WriteChar(","); Kernel.WriteInt(w, 1); Kernel.WriteChar(",");
Kernel.WriteInt(h, 1); Kernel.WriteChar(","); Kernel.WriteInt(mode, 1);
Kernel.WriteString(") ")
END ReplConst;
PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);
BEGIN
Kernel.WriteString("FillPattern("); Kernel.WriteInt(col, 1); Kernel.WriteChar(",");
Kernel.WriteHex(pat, 8); Kernel.WriteChar(","); Kernel.WriteInt(px, 1); Kernel.WriteChar(",");
Kernel.WriteInt(py, 1); Kernel.WriteChar(","); Kernel.WriteInt(x, 1);
Kernel.WriteChar(","); Kernel.WriteInt(y, 1); Kernel.WriteChar(",");
Kernel.WriteInt(w, 1); Kernel.WriteChar(","); Kernel.WriteInt(h, 1);
Kernel.WriteChar(","); Kernel.WriteInt(mode, 1); Kernel.WriteString(") ")
END FillPattern;
PROCEDURE ReplPattern*(col: Color; pat: Pattern; x, y, w, h, mode: LONGINT);
BEGIN
Kernel.WriteString("Repl/");
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: LONGINT; i: INTEGER; p: PatternPtr; inter: SET; pl: List;
BEGIN
Kernel.WriteString("NewPattern("); Kernel.WriteInt(w, 1); Kernel.WriteChar(",");
Kernel.WriteInt(h, 1); Kernel.WriteString(") ");
len := (w+7) DIV 8;
SYSTEM.NEW(p, 4+len*h); p.w := SHORT(SHORT(w)); p.h := SHORT(SHORT(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 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(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
Kernel.WriteString("Depth("); Kernel.WriteInt(x, 1); Kernel.WriteString(") ");
RETURN 8
END Depth;
PROCEDURE TrueColor*(x: LONGINT): BOOLEAN;
BEGIN
RETURN FALSE
END TrueColor;
PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT);
BEGIN
Kernel.WriteString("DisplayBlock("); Kernel.WriteHex(adr, 8); Kernel.WriteChar(",");
Kernel.WriteInt(dx, 1); Kernel.WriteChar(","); Kernel.WriteInt(dy, 1); Kernel.WriteChar(",");
Kernel.WriteInt(w, 1); Kernel.WriteChar(","); Kernel.WriteInt(h, 1);
Kernel.WriteChar(","); Kernel.WriteInt(sx, 1); Kernel.WriteChar(",");
Kernel.WriteInt(sy, 1); Kernel.WriteChar(","); Kernel.WriteInt(mode, 1);
Kernel.WriteString(") ")
END DisplayBlock;
PROCEDURE TransferFormat*(x: LONGINT): LONGINT;
BEGIN
Kernel.WriteString("TransferFormat("); Kernel.WriteInt(x, 1); Kernel.WriteString(") ");
RETURN unknown
END TransferFormat;
PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT);
BEGIN
Kernel.WriteString("TransferBlock("); Kernel.WriteHex(SYSTEM.ADR(buf[0]), 8); Kernel.WriteChar(",");
Kernel.WriteInt(ofs, 1); Kernel.WriteChar(","); Kernel.WriteInt(stride, 1); Kernel.WriteChar(",");
Kernel.WriteInt(x, 1); Kernel.WriteChar(","); Kernel.WriteInt(y, 1);
Kernel.WriteChar(","); Kernel.WriteInt(w, 1); Kernel.WriteChar(",");
Kernel.WriteInt(h, 1); Kernel.WriteChar(","); Kernel.WriteInt(mode, 1);
Kernel.WriteString(") ")
END TransferBlock;
BEGIN
Width := 640;
Height := 480;
Left:= 0;
ColLeft:= 0;
Bottom:= 0;
UBottom:= -330;
CreatePatterns;
Unit := 10000
END Display.