-
Notifications
You must be signed in to change notification settings - Fork 0
/
RISC.Display.Mod.txt
190 lines (179 loc) · 8.2 KB
/
RISC.Display.Mod.txt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
MODULE Display; (*NW 5.11.2013 / 17.1.2019*)
IMPORT SYSTEM;
CONST black* = 0; white* = 1; (*black = background*)
replace* = 0; paint* = 1; invert* = 2; (*modes*)
base = 0E7F00H; (*adr of 1024 x 768 pixel, monocolor display frame*)
TYPE Frame* = POINTER TO FrameDesc;
FrameMsg* = RECORD END ;
Handler* = PROCEDURE (F: Frame; VAR M: FrameMsg);
FrameDesc* = RECORD next*, dsc*: Frame;
X*, Y*, W*, H*: INTEGER;
handle*: Handler
END ;
VAR Base*, Width*, Height*: INTEGER;
arrow*, star*, hook*, updown*, block*, cross*, grey*: INTEGER;
(*a pattern is an array of bytes; the first is its width (< 32), the second its height, the rest the raster*)
PROCEDURE Handle*(F: Frame; VAR M: FrameMsg);
BEGIN
IF (F # NIL) & (F.handle # NIL) THEN F.handle(F, M) END
END Handle;
(* raster ops *)
PROCEDURE Dot*(col, x, y, mode: INTEGER);
VAR a: INTEGER; u, s: SET;
BEGIN a := base + (x DIV 32)*4 + y*128;
s := {x MOD 32}; SYSTEM.GET(a, u);
IF mode = paint THEN SYSTEM.PUT(a, u + s)
ELSIF mode = invert THEN SYSTEM.PUT(a, u / s)
ELSE (*mode = replace*)
IF col # black THEN SYSTEM.PUT(a, u + s) ELSE SYSTEM.PUT(a, u - s) END
END
END Dot;
PROCEDURE ReplConst*(col, x, y, w, h, mode: INTEGER);
VAR al, ar, a0, a1: INTEGER; left, right, mid, pix, pixl, pixr: SET;
BEGIN al := base + y*128;
ar := ((x+w-1) DIV 32)*4 + al; al := (x DIV 32)*4 + al;
IF ar = al THEN
mid := {(x MOD 32) .. ((x+w-1) MOD 32)};
FOR a1 := al TO al + (h-1)*128 BY 128 DO
SYSTEM.GET(a1, pix);
IF mode = invert THEN SYSTEM.PUT(a1, pix / mid)
ELSIF (mode = replace) & (col = black) THEN (*erase*) SYSTEM.PUT(a1, pix - mid)
ELSE (* (mode = paint) OR (mode = replace) & (col # black) *) SYSTEM.PUT(a1, pix + mid)
END
END
ELSIF ar > al THEN
left := {(x MOD 32) .. 31}; right := {0 .. ((x+w-1) MOD 32)};
FOR a0 := al TO al + (h-1)*128 BY 128 DO
SYSTEM.GET(a0, pixl); SYSTEM.GET(ar, pixr);
IF mode = invert THEN
SYSTEM.PUT(a0, pixl / left);
FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.GET(a1, pix); SYSTEM.PUT(a1, -pix) END ;
SYSTEM.PUT(ar, pixr / right)
ELSIF (mode = replace) & (col = black) THEN (*erase*)
SYSTEM.PUT(a0, pixl - left);
FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.PUT(a1, {}) END ;
SYSTEM.PUT(ar, pixr - right)
ELSE (* (mode = paint) OR (mode = replace) & (col # black) *)
SYSTEM.PUT(a0, pixl + left);
FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.PUT(a1, {0 .. 31}) END ;
SYSTEM.PUT(ar, pixr + right)
END ;
INC(ar, 128)
END
END
END ReplConst;
PROCEDURE CopyPattern*(col, patadr, x, y, mode: INTEGER); (*only for modes = paint, invert*)
VAR a, a0, pwd: INTEGER;
w, h, pbt: BYTE; pix, mask: SET;
BEGIN SYSTEM.GET(patadr, w); SYSTEM.GET(patadr+1, h); INC(patadr, 2);
a := base + (x DIV 32)*4 + y*128; x := x MOD 32; mask := SYSTEM.VAL(SET, ASR(7FFFFFFFH, 31-x));
FOR a0 := a TO a + (h-1)*128 BY 128 DO
(*build pattern line; w <= 32*)
SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt;
IF w > 8 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*100H + pwd;
IF w > 16 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*10000H + pwd;
IF w > 24 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*1000000H + pwd END
END
END ;
SYSTEM.GET(a0, pix);
IF mode = invert THEN SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x)) / pix)
ELSE SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x)) + pix)
END ;
IF x + w > 32 THEN (*spill over*)
SYSTEM.GET(a0+4, pix);
IF mode = invert THEN SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -x)) * mask/ pix)
ELSE SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -x)) * mask+ pix)
END
END
END
END CopyPattern;
PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: INTEGER); (*only for mode = replace*)
VAR sa, da, sa0, sa1, d, len: INTEGER;
u0, u1, u2, u3, v0, v1, v2, v3, n: INTEGER;
end, step: INTEGER;
src, dst, spill: SET;
m0, m1, m2, m3: SET;
BEGIN
u0 := sx DIV 32; u1 := sx MOD 32; u2 := (sx+w) DIV 32; u3 := (sx+w) MOD 32;
v0 := dx DIV 32; v1 := dx MOD 32; v2 := (dx+w) DIV 32; v3 := (dx+w) MOD 32;
sa := base + u0*4 + sy*128; da := base + v0*4 + dy*128;
d := da - sa; n := u1 - v1; (*displacement in words and bits*)
len := (u2 - u0) * 4;
m0 := {v1 .. 31}; m2 := {v3 .. 31}; m3 := m0 / m2;
IF d >= 0 THEN (*copy up, scan down*) sa0 := sa + (h-1)*128; end := sa-128; step := -128
ELSE (*copy down, scan up*) sa0 := sa; end := sa + h*128; step := 128
END ;
WHILE sa0 # end DO
IF n >= 0 THEN (*shift right*) m1 := {n .. 31};
IF v1 + w >= 32 THEN
SYSTEM.GET(sa0+len, src); src := ROR(src, n);
SYSTEM.GET(sa0+len+d, dst);
SYSTEM.PUT(sa0+len+d, (dst * m2) + (src - m2));
spill := src - m1;
FOR sa1 := sa0 + len-4 TO sa0+4 BY -4 DO
SYSTEM.GET(sa1, src); src := ROR(src, n);
SYSTEM.PUT(sa1+d, spill + (src * m1));
spill := src - m1
END ;
SYSTEM.GET(sa0, src); src := ROR(src, n);
SYSTEM.GET(sa0+d, dst);
SYSTEM.PUT(sa0+d, (src * m0) + (dst - m0))
ELSE SYSTEM.GET(sa0, src); src := ROR(src, n);
SYSTEM.GET(sa0+d, dst);
SYSTEM.PUT(sa0+d, (src * m3) + (dst - m3))
END
ELSE (*shift left*) m1 := {-n .. 31};
SYSTEM.GET(sa0, src); src := ROR(src, n);
SYSTEM.GET(sa0+d, dst);
IF v1 + w < 32 THEN
SYSTEM.PUT(sa0+d, (dst - m3) + (src * m3))
ELSE SYSTEM.PUT(sa0+d, (dst - m0) + (src * m0));
spill := src - m1;
FOR sa1 := sa0+4 TO sa0 + len-4 BY 4 DO
SYSTEM.GET(sa1, src); src := ROR(src, n);
SYSTEM.PUT(sa1+d, spill + (src * m1));
spill := src - m1
END ;
SYSTEM.GET(sa0+len, src); src := ROR(src, n);
SYSTEM.GET(sa0+len+d, dst);
SYSTEM.PUT(sa0+len+d, (src - m2) + (dst * m2))
END
END ;
INC(sa0, step)
END
END CopyBlock;
PROCEDURE ReplPattern*(col, patadr, x, y, w, h, mode: INTEGER);
(* pattern width = 32, fixed; pattern starts at patadr+4, for mode = invert only *)
VAR al, ar, a0, a1: INTEGER;
pta0, pta1: INTEGER; (*pattern addresses*)
ph: BYTE;
left, right, mid, pix, pixl, pixr, ptw: SET;
BEGIN al := base + y*128; SYSTEM.GET(patadr+1, ph);
pta0 := patadr+4; pta1 := ph*4 + pta0;
ar := ((x+w-1) DIV 32)*4 + al; al := (x DIV 32)*4 + al;
IF ar = al THEN
mid := {(x MOD 32) .. ((x+w-1) MOD 32)};
FOR a1 := al TO al + (h-1)*128 BY 128 DO
SYSTEM.GET(a1, pix); SYSTEM.GET(pta0, ptw); SYSTEM.PUT(a1, (pix - mid) + (pix/ptw * mid)); INC(pta0, 4);
IF pta0 = pta1 THEN pta0 := patadr+4 END
END
ELSIF ar > al THEN
left := {(x MOD 32) .. 31}; right := {0 .. ((x+w-1) MOD 32)};
FOR a0 := al TO al + (h-1)*128 BY 128 DO
SYSTEM.GET(a0, pixl); SYSTEM.GET(pta0, ptw); SYSTEM.PUT(a0, (pixl - left) + (pixl/ptw * left));
FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.GET(a1, pix); SYSTEM.PUT(a1, pix/ptw) END ;
SYSTEM.GET(ar, pixr); SYSTEM.PUT(ar, (pixr - right) + (pixr/ptw * right));
INC(pta0, 4); INC(ar, 128);
IF pta0 = pta1 THEN pta0 := patadr+4 END
END
END
END ReplPattern;
BEGIN Base := base; Width := 1024; Height := 768;
arrow := SYSTEM.ADR($0F0F 0060 0070 0038 001C 000E 0007 8003 C101 E300 7700 3F00 1F00 3F00 7F00 FF00$);
star := SYSTEM.ADR($0F0F 8000 8220 8410 8808 9004 A002 C001 7F7F C001 A002 9004 8808 8410 8220 8000$);
hook := SYSTEM.ADR($0C0C 070F 8707 C703 E701 F700 7F00 3F00 1F00 0F00 0700 0300 01$);
updown := SYSTEM.ADR($080E 183C 7EFF 1818 1818 1818 FF7E3C18$);
block := SYSTEM.ADR($0808 FFFF C3C3 C3C3 FFFF$);
cross := SYSTEM.ADR($0F0F 0140 0220 0410 0808 1004 2002 4001 0000 4001 2002 1004 0808 0410 0220 0140$);
grey := SYSTEM.ADR($2002 0000 5555 5555 AAAA AAAA$)
END Display.