text:
Oberon/ETH Oberon/2.3.7/S3C924.Display.Mod

(* 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;	(* 86C924 ard, pjm *) 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; (* S3 Constants *) index = 3D4H; data = 3D5H; Xpos = 20H; Ypos = 80H; Ymajor = 40H; advFnCtrl = 4AE8H; curX = 86E8H; curY = 82E8H; axStep = 8AE8H; diaStep = 8EE8H; errTerm = 92E8H; majAxis = 96E8H; minAxis = 0BEE8H; gpStat = 9AE8H; cmdReg = 9AE8H; shortStroke = 9EE8H; BGcol = 0A2E8H; FGcol = 0A6E8H; wrtMask = 0AAE8H; rdMask = 0AEE8H; BGmix = 0B6E8H; FGmix = 0BAE8H; MFcont = 0BEE8H; pixTrans = 0E2E8H; 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*: (* map hight*) INTEGER; arrow*, star*, cross*, downArrow*, hook*, grey0*, grey1*, grey2*, ticks*, solid*: Pattern; Broadcast*: MsgProc; dmem, lasty: LONGINT; Pat: List; clipx, clipy, clipright, cliptop, height, width: INTEGER;	(* clipping variables *) pixctrl1, pixctrl2, copycmd: LONGINT; mask: INTEGER; depth: INTEGER; palette: ARRAY 256 OF LONGINT; PROCEDURE WaitFIFO1; CODE {SYSTEM.i386} MOV DX, 09AE8H lab1: IN AX, DX 		AND AX, 0FFH-127 JNZ lab1 END WaitFIFO1; PROCEDURE WaitFIFO2; CODE {SYSTEM.i386} MOV DX, 09AE8H lab2: IN AX, DX 		AND AX, 0FFH-63 JNZ lab2 END WaitFIFO2; PROCEDURE WaitFIFO3; CODE {SYSTEM.i386} MOV DX, 09AE8H lab3: IN AX, DX 		AND AX, 0FFH-31 JNZ lab3 END WaitFIFO3; PROCEDURE WaitFIFO4; CODE {SYSTEM.i386} MOV DX, 09AE8H lab4: IN AX, DX 		AND AX, 0FFH-15 JNZ lab4 END WaitFIFO4; PROCEDURE WaitFIFO5; CODE {SYSTEM.i386} MOV DX, 09AE8H lab5: IN AX, DX 		AND AX, 0FFH-7 JNZ lab5 END WaitFIFO5; PROCEDURE WaitFIFO6; CODE {SYSTEM.i386} MOV DX, 09AE8H lab6: IN AX, DX 		AND AX, 0FFH-3 JNZ lab6 END WaitFIFO6; PROCEDURE WaitFIFO7; CODE {SYSTEM.i386} MOV DX, 09AE8H lab7: IN AX, DX 		AND AX, 0FFH-1 JNZ lab7 END WaitFIFO7; PROCEDURE WaitFIFO8; CODE {SYSTEM.i386} MOV DX, 09AE8H lab8: IN AX, DX 		AND AX, 0FFH JNZ lab8 END WaitFIFO8; PROCEDURE EnableRegs; VAR i: INTEGER; BEGIN WaitFIFO2; SYSTEM.PORTOUT(wrtMask, mask);		; (* Write mask *) SYSTEM.PORTOUT(rdMask, mask);		; (* Read mask *) END EnableRegs; PROCEDURE max (i, j: INTEGER): INTEGER; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max; PROCEDURE min (i, j: INTEGER): INTEGER; BEGIN	IF i >= j THEN RETURN j ELSE RETURN i END END min; PROCEDURE Map*(x: LONGINT): LONGINT; BEGIN RETURN 0A0000H	(* Start of the video RAM *) END Map; PROCEDURE AdjustClip*(x, y, w, h: LONGINT); VAR right, top, left, bottom: INTEGER; BEGIN right := SHORT(x + w); top := SHORT(y + h); clipx := max(clipx, SHORT(x)); clipy := max(clipy, SHORT(y)); clipright := min(right, clipright); cliptop := min(top, cliptop); top := height-1-cliptop; left := clipx; bottom := height-1-clipy; right := clipright-1; IF top < 0 THEN top := 0 ELSIF top > height-1 THEN top := height-1 END; IF left < 0 THEN left := 0 ELSIF left > width THEN left := width END; IF bottom < 0 THEN bottom := 0 ELSIF bottom > height-1 THEN bottom := height-1 END; IF right < 0 THEN right := 0 ELSIF right > width THEN right := width END; WaitFIFO4; SYSTEM.PORTOUT(MFcont, 1000H + top);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H + left); 			 (* left *) SYSTEM.PORTOUT(MFcont, 3000H + bottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + right); 		 (* right *) 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-1; WaitFIFO4; SYSTEM.PORTOUT(MFcont, 1000H);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H);	(* left *) SYSTEM.PORTOUT(MFcont, 3000H + height-1-UBottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + width-1);	(* right *) END ResetClip; PROCEDURE SetClip*(x, y, w, h: LONGINT); VAR right, top, left, bottom: INTEGER; BEGIN clipright := SHORT(x+w); cliptop := SHORT(y+h); clipy := SHORT(y); clipx := SHORT(x); top := height-1-cliptop; left := clipx; bottom := height-1-clipy; right := clipright-1; WaitFIFO4; SYSTEM.PORTOUT(MFcont, 1000H + top);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H + left); 			 (* left *) SYSTEM.PORTOUT(MFcont, 3000H + bottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + right); 		 (* right *) 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 *) 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: the S3 uses 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; red := (red + 4) DIV 4 -1; green := (green + 4) DIV 4 -1; blue := (blue + 4) DIV 4 -1; SYSTEM.PORTOUT(3C8H, CHR(col)); 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 Dot*(col: Color; x, y, mode: LONGINT); BEGIN y := Height-1-y; WaitFIFO7; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 121BH); SYSTEM.PORTOUT(shortStroke, LONG(10H)); END Dot; PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); VAR xpos, ypos: INTEGER; BEGIN IF (w > 0) & (h > 0) THEN xpos := 0; ypos := 0; IF sy < dy THEN INC(sy, h-1); INC(dy, h-1); ypos := 128 END; IF sx < dx THEN INC(sx, w-1); INC(dx, w-1) ELSE xpos := 32 END; sy := Height - 1- sy; dy := Height -1- dy; DEC(w); DEC(h); WaitFIFO1; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(65H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(67H)) END; WaitFIFO8; SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(sx)); SYSTEM.PORTOUT(curY, SHORT(sy)); SYSTEM.PORTOUT(diaStep, SHORT(dx)); SYSTEM.PORTOUT(axStep, SHORT(dy)); SYSTEM.PORTOUT(majAxis, SHORT(w)); SYSTEM.PORTOUT(MFcont, SHORT(h)); SYSTEM.PORTOUT(cmdReg, SHORT(copycmd) + xpos + ypos) END END CopyBlock; PROCEDURE SetMode*(x: LONGINT; s: SET); BEGIN END SetMode; PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT); VAR width, height: SHORTINT; diastep, axstep, errterm, bit16: INTEGER; bit8: CHAR; bit24, bit32: SET; BEGIN SYSTEM.GET(pat, width); SYSTEM.GET(pat+1, height); INC(pat, 2); width := (width+7) DIV 8 * 8; axstep := 0; diastep := -2*width; errterm := -width-1; INC(x, LONG(LONG(width-1))); y := Height-1-y; WaitFIFO8; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSIF mode = paint THEN SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(1H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl2)); SYSTEM.PORTOUT(majAxis, LONG(width)-1); SYSTEM.PORTOUT(diaStep, diastep); SYSTEM.PORTOUT(axStep, axstep); SYSTEM.PORTOUT(errTerm, errterm); IF width <= 8 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit8); INC(pat); WaitFIFO4; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); SYSTEM.PORTOUT(pixTrans, ORD(bit8) * 100H); DEC(y); END ELSIF width <= 16 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit16); INC(pat, 2); WaitFIFO4; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); SYSTEM.PORTOUT(pixTrans, bit16); DEC(y); END ELSIF width <=24 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit24); INC(pat, 3); bit24 := SYSTEM.LSH(bit24 * {0 .. 23}, 8); bit24 := SYSTEM.ROT(bit24, 16); WaitFIFO5; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit24*{0..15})); bit24 := SYSTEM.ROT(bit24, 16); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit24*{0..15})); DEC(y); END ELSE WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit32); INC(pat, 4); bit32 := SYSTEM.ROT(bit32, 16); WaitFIFO5; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit32*{0..15})); bit32 := SYSTEM.ROT(bit32, 16); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit32*{0..15})); DEC(y); END END; END CopyPattern; PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); BEGIN IF (w > 0) & (h > 0) THEN DEC(h); DEC(w); y := Height-1-y; WaitFIFO8; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(majAxis, SHORT(w)); SYSTEM.PORTOUT(minAxis, SHORT(h)); SYSTEM.PORTOUT(cmdReg, 4073H) END END ReplConst; PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); VAR patwidth, patheight: SHORTINT; diastep, axstep, errterm, bit16: INTEGER; offset, W0, Y0, X0: INTEGER; pat0, bit32: LONGINT; wth, hgt: INTEGER; BEGIN IF (w > 0) & (h > 0) THEN SYSTEM.GET(pat, patwidth); SYSTEM.GET(pat+1, patheight); INC(pat, 2); wth := SHORT(w+7) DIV 8 * 8;	(* nof complete bytes *) axstep := 0; diastep := -2*wth; errterm := -wth-1; INC(x, w-1); Y0 := SHORT(y); X0 := SHORT(x); y := Height-1-y; WaitFIFO8; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSIF mode = paint THEN SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(1H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl2)); SYSTEM.PORTOUT(majAxis, SHORT(w-1)); SYSTEM.PORTOUT(diaStep, diastep); SYSTEM.PORTOUT(axStep, axstep); SYSTEM.PORTOUT(errTerm, errterm); pat0 := pat; W0 := SHORT(w); hgt := patheight - (Y0 + SHORT(py)) MOD patheight; offset := (Y0 + SHORT(py)) MOD patheight; IF patwidth = 16 THEN pat := pat + 2*offset; WHILE h > 0 DO 					w := (w + 7) DIV 8 * 4; SYSTEM.GET(pat, bit16); INC(pat, 2); bit16 := SYSTEM.ROT(bit16, SHORT(px)-X0); WaitFIFO3; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); WHILE w > 0 DO 						WaitFIFO1; SYSTEM.PORTOUT(pixTrans, bit16); DEC(w,2); END; DEC(y); DEC(h); DEC(hgt); w := W0; IF hgt <= 0 THEN hgt := patheight; pat := pat0 END; END ELSIF patwidth = 32 THEN pat := pat + 4*offset; WHILE h > 0 DO 					w := (w + 7) DIV 8 * 2; SYSTEM.GET(pat, bit32); INC(pat, 4); bit32 := SYSTEM.ROT(bit32, SHORT(px)-X0+16); WaitFIFO3; SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); WHILE w > 0 DO 						WaitFIFO2; SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, bit32)*{0..15})); bit32 := SYSTEM.ROT(bit32, 16); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, bit32)*{0..15})); DEC(w,4) END; DEC(y); DEC(h); DEC(hgt); w := W0; IF hgt <= 0 THEN hgt := patheight; pat := pat0 END END 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[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 := 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] := -{}; 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 BitmapWth, locW, locH: LONGINT; CODE {SYSTEM.i386} MOVSX EAX, Width MOV locW[EBP], EAX	; locW := Width MOVSX EAX, Height DEC EAX MOV locH[EBP], EAX	; locH := Height-1 MOV ESI, adr[EBP]   		; address of bitmap descriptor MOV EDI, 12[ESI] MOV ESI, 8[ESI] MOV BitmapWth[EBP], ESI MOV ECX, dy[EBP] IMUL ESI,ECX MOV EBX, dx[EBP] ADD ESI, EBX ADD ESI, EDI				; esi = source index register MOV EDI, locW[EBP] MOV EBX, locH[EBP] DEC EBX										;!!!! SUB EBX,sy[EBP] IMUL EDI,EBX MOV EBX, sx[EBP] ADD EDI, EBX				; edi = destination index register without VGAaddr MOV EAX, locH[EBP] SUB EAX, sy[EBP] MOV sy[EBP], EAX MOV DX, 9AE8H lab1: IN AX, DX 		AND AX, 100H JNZ lab1 CMP mode[EBP], 1 JL repllab JG invlab MOV AX, 4BH JMP contlab repllab: MOV AX, 47H JMP contlab invlab: MOV AX, 45H contlab: MOV DX, 0BAE8H OUT DX, AX 		MOV DX, 0BEE8H MOV AX, 0A000H OUT DX, AX 		MOV DX, 086E8H MOV AX, WORD sx[EBP] OUT DX, AX 		MOV DX, 082E8H MOV AX, WORD sy[EBP] OUT DX, AX 		MOV DX, 096E8H MOV AX, WORD w[EBP] DEC AX 		OUT DX, AX 		MOV DX, 0BEE8H MOV AX, WORD h[EBP] DEC AX 		OUT DX, AX 		MOV DX, 09AE8H MOV AX, 05331H OUT DX, AX 		MOV DX, 0E2E8H RowLoopR: MOV CX, WORD w[EBP] INC CX 		SHR CX, 1 PUSH ESI lab2: MOV AX, [ESI] OUT DX, AX 		INC ESI INC ESI DEC CX 		JNZ lab2 POP ESI ADD ESI, BitmapWth[EBP] DEC h[EBP] JNZ RowLoopR DispEnd: 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 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; Pat := NIL; mask := -1; pixctrl1 := 0A000H; pixctrl2 := 0A080H; copycmd := 0C053H; EnableRegs; width := Width; height := Height; ResetClip; CreatePatterns; Unit := 10000 END Display.


text:
Oberon/ETH Oberon/2.3.7/S3Trio.Display.Mod

(* 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: S3 Trio64 (ard, pjm, Peter Matthias) *) 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; (* S3 Constants, packed MMIO *) curY= 0A8100H;		curX= 0A8102H; axStep= 0A8108H;		diaStep= 0A810AH; errTerm= 0A8110H; cmd= 0A8118H; shortStroke= 0A811CH; BGcol= 0A8120H; FGcol= 0A8124H; wrtMask= 0A8128H; rdMask= 0A812CH; ColorCMP= 0A8130H; BGmix= 0A8134H;	FGmix= 0A8136H;	AltMix= 0A8134H; ScissorsT= 0A8138H;	ScissorsL= 0A813AH;	(* clipping top, left *) ScissorsB= 0A813CH;	ScissorsR= 0A813EH;	(* clipping bottom, right *) PixCntl= 0A8140H;	MultMisc2= 0A8142H; MultMisc= 0A8144H;	ReadSel= 0A8146H; MinAxis= 0A8148H;	MajAxis= 0A814AH; pixTrans = 0AE2E8H; pixBase = 0A0000H; FBPhysAdr = 0E0000000H; RegPhysAdr = 0A0000H; RegSize = 10000H; 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 height *) arrow*, star*, cross*, downArrow*, hook*, grey0*, grey1*, grey2*, ticks*, solid*: Pattern; Broadcast*: MsgProc; Pat: List;	(* root for patterns *) dmem, fbase, rbase: LONGINT; clipx, clipy, clipright, cliptop: LONGINT;	(* clipping variables *) depth: INTEGER;	(* "logical" indexed color depth 1 or 8 *) truecol: LONGINT;	(* 0 = 256-color palette, 1 = hicolor, 2 = truecolor *) colmap: ARRAY 256 OF LONGINT;	(* identity mapping (256-color) or soft palette (hicolor, truecolor) *) palette: ARRAY 256 OF LONGINT;	(* cache to speed up palette reading *) PROCEDURE Wait; VAR wait: INTEGER; BEGIN REPEAT SYSTEM.GET( rbase+cmd, wait) UNTIL ~ODD( ASH( wait, -9)); END Wait; PROCEDURE Map*(x: LONGINT): LONGINT; BEGIN RETURN fbase		(* of linear framebuffer *) END Map; PROCEDURE AdjustClip*(x, y, w, h: LONGINT); VAR right, top, left, bottom: LONGINT; BEGIN right := x + w; 	IF x > clipx THEN clipx:= x END; IF right < clipright THEN clipright:= right END; left:= clipx; IF left < 0 THEN left := 0 ELSIF left > Width THEN left := Width-1 END; right := clipright-1; IF right < 0 THEN right := 0 ELSIF right > Width THEN right := Width-1 END; top := y + h; 	IF y> clipy THEN clipy:= y END; IF top< cliptop THEN cliptop:= top END; top := cliptop-1; IF top < 0 THEN top := 0 ELSIF top >= Height THEN top := Height-1 END; bottom := clipy; IF bottom < 0 THEN bottom := 0 ELSIF bottom > Height THEN bottom := Height-1 END; SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H+ Height-1-top));	(* top *) SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H+ left)); 	(* left *) SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H+ Height-1-bottom));	(* bottom *) SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H+ right))	(* right *) END AdjustClip; PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER); VAR p: PatternPtr; BEGIN p:= SYSTEM.VAL( PatternPtr, pat); w:= ORD(p^.w); h:= ORD(p^.h) END GetDim; PROCEDURE ResetClip*; BEGIN clipx := 0; clipy := UBottom; clipright := Width; cliptop := Height; SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H));	(* top *) SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H));	(* left *) SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H+ Height-1-UBottom));	(* bottom *) SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H+ Width-1))	(* right *) END ResetClip; PROCEDURE SetClip*(x, y, w, h: LONGINT); BEGIN clipright := x+w; cliptop := y+h; clipy := y; clipx := x; 	SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H + Height-cliptop));	(* top *) SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H + clipx));	(* left *) SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H + Height-1-clipy));	(* bottom *) SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H + clipright-1)); 		 (* right *) 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; CASE truecol OF 		0:	(* indexed *) colmap[col] := col; IF (col = 0) OR (col = 15) THEN	(* either 0 or 15 must be black. set the border to black. *) (* note: the S3 uses 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)) |1:	(* 565 hicolor *) colmap[col] := ASH(ASH(ASH(red, -3), 6) + ASH(green, -2), 5) + ASH(blue, -3) |2:	(* 888 truecolor *) colmap[col] := ASH(ASH(red, 8) + green, 8) + blue END 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; (* Translate a Color value 	col >= 0 => index through colmap 	col < 0 & truecol = 0 => undefined 	col < 0 & truecol = 1 => translate 888 to 565 	col < 0 & truecol = 2 => keep lower 24 bits 	Note: when mode = invert & truecol # 0 & col = FG, the caller sets col to 80FFFFFFH. 	This is a special case for backward compatability with older viewers to invert using FG. *) PROCEDURE -TransColor(col: Color): LONGINT; CODE {SYSTEM.i386} POP EAX CMP EAX, 0 JGE index AND EAX, 0FFFFFFH CMP truecol, 1 JNE end MOV EBX, EAX MOV ECX, EAX SHR EAX, 8	; 23..19 -> 15..11 SHR EBX, 5	; 15..10 -> 10..5 SHR ECX, 3	; 7..3 -> 4..0 AND EAX, 0F800H	; 15..11 AND EBX, 007E0H	; 10..5 AND ECX, 0001FH	; 4..0 OR EAX, EBX OR EAX, ECX JMP end index: AND EAX, 0FFH LEA EBX, colmap MOV EAX, [EBX][EAX*4] end: END TransColor; PROCEDURE Dot*(col: Color; x, y, mode: LONGINT); BEGIN IF mode = invert THEN IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END; SYSTEM.PUT(rbase+FGmix, LONG(25H)) ELSE SYSTEM.PUT(rbase+FGmix, LONG(27H)) END; SYSTEM.PUT(rbase+FGcol, TransColor(col)); SYSTEM.PUT(rbase+PixCntl, LONG( 0)); SYSTEM.PUT(rbase+curX, SHORT(x)); SYSTEM.PUT(rbase+curY, SHORT(Height-1-y)); Wait; SYSTEM.PUT(rbase+cmd, 121BH); SYSTEM.PUT(rbase+shortStroke, LONG(10H)) END Dot; PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); VAR comd: INTEGER; BEGIN IF (w > 0) & (h > 0) THEN comd := SYSTEM.VAL(INTEGER, 0C073H); IF sy <= dy THEN INC(sy, h-1); INC(dy, h-1); INC(comd, 128); IF sx < dx THEN INC(sx, w-1); INC(dx, w-1); DEC(comd, 32) END END; IF mode = invert THEN SYSTEM.PUT(rbase+FGmix, LONG(65H)) ELSE SYSTEM.PUT(rbase+FGmix, LONG(67H)) END; SYSTEM.PUT(rbase+PixCntl, LONG(0)); SYSTEM.PUT(rbase+curX, SHORT(sx)); SYSTEM.PUT(rbase+curY, SHORT(Height - 1 - sy)); SYSTEM.PUT(rbase+diaStep, SHORT(dx)); SYSTEM.PUT(rbase+axStep, SHORT(Height -1 - dy)); SYSTEM.PUT(rbase+MajAxis, SHORT(w-1)); SYSTEM.PUT(rbase+MinAxis, SHORT(h-1)); Wait; SYSTEM.PUT(rbase+cmd, comd) END END CopyBlock; PROCEDURE SetMode*(x: LONGINT; s: SET); BEGIN END SetMode; PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT); VAR wth, pwidth, pos: LONGINT; p: PatternPtr; BEGIN p:= SYSTEM.VAL( PatternPtr, pat); wth:=(ORD(p.w)+7) DIV 8; INC(x, wth*8-1); y := Height-y-ORD(p.h); IF mode= invert THEN IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END; SYSTEM.PUT(rbase+AltMix, 250003H) ELSIF mode= replace THEN SYSTEM.PUT(rbase+AltMix, 270001H) ELSE SYSTEM.PUT(rbase+AltMix, 270003H) END; SYSTEM.PUT(rbase+FGcol, TransColor(col)); SYSTEM.PUT(rbase+PixCntl, ORD( 80X)); SYSTEM.PUT(rbase+MajAxis, SHORT( wth*8-1)); pos:= wth*ORD(p.h); WHILE pos>0 DO 		SYSTEM.PUT(rbase+curX, SHORT(x)); SYSTEM.PUT(rbase+curY, SHORT(y)); Wait; SYSTEM.PUT(rbase+cmd, 219BH); pwidth:= wth; REPEAT DEC( pos); DEC( pwidth); SYSTEM.PUT( rbase+pixTrans, p.pixmap[ pos]); UNTIL (pwidth<=0); INC( y) 	END END CopyPattern; PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); BEGIN IF (w > 0) & (h > 0) THEN IF mode = invert THEN IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END; SYSTEM.PUT(rbase+FGmix, LONG(25H)) ELSE SYSTEM.PUT(rbase+FGmix, LONG(27H)) END; SYSTEM.PUT(rbase+FGcol, TransColor(col)); SYSTEM.PUT(rbase+PixCntl, LONG( 0)); SYSTEM.PUT(rbase+curX, SHORT(x)); SYSTEM.PUT(rbase+curY, SHORT(Height-1-y)); SYSTEM.PUT(rbase+MajAxis, SHORT(w-1)); SYSTEM.PUT(rbase+MinAxis, SHORT(h-1)); Wait; SYSTEM.PUT(rbase+cmd, 4073H) END END ReplConst; PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); VAR bit16: INTEGER; pat0, bit32, yo, hgt, wdt: LONGINT;  p: PatternPtr; BEGIN IF (w > 0) & (h > 0) THEN p:= SYSTEM.VAL( PatternPtr, pat); INC(pat, 2); INC(x, w-1); yo:= (y + py) MOD ORD(p.h); y := Height-1-y; IF mode= invert THEN IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END; SYSTEM.PUT( rbase+AltMix, 250003H) ELSIF mode= replace THEN SYSTEM.PUT( rbase+AltMix, 270001H) ELSE SYSTEM.PUT( rbase+AltMix, 270003H) END; SYSTEM.PUT(rbase+FGcol, TransColor(col)); SYSTEM.PUT(rbase+PixCntl, ORD( 80X)); SYSTEM.PUT(rbase+MajAxis, SHORT(w-1)); pat0 := pat+ ORD(p.w) DIV 8 * yo; hgt := ORD(p.h) - yo; WHILE h > 0 DO 			wdt:= ( w + 7 ) DIV 8; IF ORD(p.w) = 16 THEN SYSTEM.GET(pat0, bit16); INC(pat0, 2); bit32:= LONG( bit16)* 10000H+ LONG( bit16) MOD 10000H ELSIF ORD(p.w) = 32 THEN SYSTEM.GET(pat0, bit32); INC(pat0, 4) END; bit32 := SYSTEM.ROT(bit32, px-x);	(* SYSTEM.ROT(bit32, pX-X0+16) ?? *) SYSTEM.PUT(rbase+curX, SHORT(x)); SYSTEM.PUT(rbase+curY, SHORT(y)); Wait; SYSTEM.PUT(rbase+cmd, 239BH); WHILE wdt >0 DO 				SYSTEM.PUT(rbase+pixTrans, bit32); DEC( wdt,4) END; DEC(y); DEC(h); DEC(hgt); IF hgt <= 0 THEN hgt := ORD(p.h); pat0 := pat END 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 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] := -{}; 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 truecol > 0 END TrueColor; (* help procedures for DisplayBlock *) PROCEDURE DB0( adr, bw, wdt, h: LONGINT); CODE {SYSTEM.i386} MOV ESI, adr[ EBP] MOV EAX, bw[ EBP] MOV EBX, wdt[ EBP] ADD EBX, 3 AND EBX, 0FFFFFFFCH SUB EAX, EBX SHR EBX, 2 MOV EDX, h[ EBP] CLD labY: MOV EDI, pixBase ADD EDI, rbase MOV ECX, EBX REP MOVSD ADD ESI, EAX DEC EDX JNZ labY END DB0; PROCEDURE DB1(adr, bw, wdt, h: LONGINT); CODE {SYSTEM.i386} MOV ESI, adr[EBP] MOV ECX, wdt[EBP] INC ECX AND ECX, 0FFFFFFFEH SUB bw[EBP], ECX SHR ECX, 1 MOV wdt[EBP], ECX LEA EDX, colmap CLD labY: MOV EDI, pixBase ADD EDI, rbase MOV ECX, wdt[EBP] loop: LODSW MOV EBX, EAX AND EAX, 0FFH SHR EBX, 8 MOV EAX, [EDX][EAX*4] AND EBX, 0FFH MOV EBX, [EDX][EBX*4] SHL EBX, 16 OR EAX, EBX STOSD LOOP loop ADD ESI, bw[EBP] DEC h[EBP] JNZ labY END DB1; PROCEDURE DB2(adr, bw, wdt, h: LONGINT); CODE {SYSTEM.i386} MOV ESI, adr[EBP] MOV ECX, wdt[EBP] SUB bw[EBP], ECX LEA EDX, colmap CLD labY: MOV EDI, pixBase ADD EDI, rbase MOV ECX, wdt[EBP] loop: LODSB AND EAX, 0FFH MOV EAX, [EDX][EAX*4] STOSD LOOP loop ADD ESI, bw[EBP] DEC h[EBP] JNZ labY END DB2; (* PROCEDURE DB0oberon( adr, bw, wdt, h: LONGINT); VAR i, j: LONGINT; BEGIN 	WHILE h>0 DO 		FOR i:=0 TO wdt BY 4 DO 			SYSTEM.GET( rbase+adr+i, j); 			SYSTEM.PUT( rbase+pixTrans, j);		(* pixTrans or 0A0000H..0A7FFCH *) 		END;			 		INC( adr, bw); 		DEC( h); 	END; END DB0oberon; *) PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT); VAR width, blockadr: LONGINT; BEGIN SYSTEM.GET(adr+8, width); SYSTEM.GET(adr+12, blockadr); sy := Height-1-sy; IF mode = invert THEN SYSTEM.PUT(rbase+FGmix, SYSTEM.VAL(INTEGER, 45H))	(* invert *) ELSE SYSTEM.PUT(rbase+FGmix, SYSTEM.VAL(INTEGER, 47H))	(* replace, paint *) END; SYSTEM.PUT(rbase+PixCntl, SYSTEM.VAL(INTEGER, 0A000H)); SYSTEM.PUT(rbase+curX, SHORT(sx)); SYSTEM.PUT(rbase+curY, SHORT(sy)); SYSTEM.PUT(rbase+MajAxis, SHORT(w-1)); SYSTEM.PUT(rbase+MinAxis, SHORT(h-1)); Wait; SYSTEM.PUT(rbase+cmd, SYSTEM.VAL(INTEGER, 5531H)); CASE truecol OF 		0: DB0(blockadr + width*dy + dx, width, w, h) 		|1: DB1(blockadr + width*dy + dx, width, w, h) 		|2: DB2(blockadr + width*dy + dx, width, w, h) 	END END DisplayBlock; PROCEDURE TransferFormat*(x: LONGINT): LONGINT; BEGIN CASE truecol OF 		0: x := index8 |1: x := color565 |2: x := color8888 END; RETURN x END TransferFormat; PROCEDURE -Move(src, dst, size: LONGINT); CODE {SYSTEM.i386} POP ECX POP EDI POP ESI CLD MOV BL, CL 	SHR ECX, 2 AND BL, 3 REP MOVSD MOV CL, BL 	REP MOVSB END Move; PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT); VAR src, dst0, dst1, srcstride, ofs1: LONGINT; BEGIN y := Height-1-y; IF mode = set THEN SYSTEM.PUT(rbase+FGmix, 47H); SYSTEM.PUT(rbase+PixCntl, LONG( 0H)); SYSTEM.PUT(rbase+curX, SHORT(x)); SYSTEM.PUT(rbase+curY, SHORT(y)); SYSTEM.PUT(rbase+MajAxis, SHORT(w-1)); SYSTEM.PUT(rbase+MinAxis, SHORT(h-1)); Wait; SYSTEM.PUT(rbase+cmd, 5531H); DB0(SYSTEM.ADR(buf[ofs]), stride, ASH(w, truecol), h) 	ELSIF mode = get THEN ASSERT(w >= 0); src := fbase + ASH(y*Width + x, truecol); srcstride := ASH(Width, truecol); ofs1 := ASH(w, truecol)-1; WHILE h > 0 DO 			dst0 := SYSTEM.ADR(buf[ofs]); dst1 := SYSTEM.ADR(buf[ofs+ofs1]);	(* index check *) Move(src, dst0, dst1-dst0+1); DEC(src, srcstride); INC(ofs, stride);  DEC(h) END ELSE HALT(99)	(* bad mode *) END END TransferBlock; PROCEDURE GetVal(str: ARRAY OF CHAR; default: LONGINT): LONGINT; VAR i: SHORTINT; v: 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; PROCEDURE InitS3; VAR ch: CHAR; mask, i, mode: LONGINT; BEGIN FOR i := 0 TO 255 DO colmap[i] := i END; truecol := GetVal("DDepth", 8) DIV 16;	(* 0, 1 or 2 *) mode := GetVal("Color", 1);	(* assume 1 if not specified *) IF mode = 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 *) SYSTEM.PORTOUT( 3D4H, 2DH); SYSTEM.PORTIN( 3D5H, ch); IF ch= 88X THEN SYSTEM.PORTOUT( 3D4H, 2EH); SYSTEM.PORTIN( 3D5H, ch); IF ch= 11X THEN																(*	Trio found	*) Width:=0; Height:=0; SYSTEM.PORTOUT( 3D4H, 5DH);								(* get Width *) SYSTEM.PORTIN( 3D5H, ch); IF ODD( ORD( ch) DIV 2) THEN Width:= 256*8 END; SYSTEM.PORTOUT( 3D4H, 1); SYSTEM.PORTIN( 3D5H, ch); INC( Width, ( ORD( ch)+1)*8); IF truecol = 1 THEN Width := Width DIV 2 END; SYSTEM.PORTOUT( 3D4H, 5EH);									(* get Height *) SYSTEM.PORTIN( 3D5H, ch); IF ODD( ORD( ch) DIV 2) THEN Height:= 1024 END; SYSTEM.PORTOUT( 3D4H, 7); SYSTEM.PORTIN( 3D5H, ch); IF ODD( ORD( ch) DIV 2) THEN INC( Height, 256) END; IF ODD( ORD( ch) DIV 64) THEN INC( Height, 512) END; SYSTEM.PORTOUT( 3D4H, 12H); SYSTEM.PORTIN( 3D5H, ch); INC( Height, ORD( ch)+1); SYSTEM.PORTOUT( 3D4H, 36H);									(* get MemSize *) SYSTEM.PORTIN( 3D5H, ch); mask:= ASH( ORD( ch), -5); IF mask= 0 THEN dmem:= 4096*1024; ELSIF mask= 4 THEN dmem:= 2048*1024; ELSE dmem:= 1024*1024; END; END; END; UBottom := Height - SHORT((dmem-4096) DIV Width DIV ASH(1, truecol)) + 1;	(* Space for 4 Sprites reserved *) Kernel.MapPhysical(RegPhysAdr, RegSize, rbase); ASSERT(rbase # 0); DEC(rbase, RegPhysAdr); SYSTEM.PORTOUT( 3D4H, 1053H);	(*	10H: enable old MMIO 18H: old & new MMIO	*) mask:= -1; SYSTEM.PUT(rbase+wrtMask, mask);				(* Write mask *) SYSTEM.PUT(rbase+rdMask, mask);					(* Read mask *) Kernel.MapPhysical(FBPhysAdr, dmem, fbase); IF fbase # 0 THEN										(* enable lfb *) SYSTEM.PORTOUT( 3D4H, 0831H);		(* CR31 bit 3: enhanced mode mapping*) IF dmem<=1024*1024 THEN SYSTEM.PORTOUT( 3D4H, 1158H); ELSIF dmem<=2024*1024 THEN SYSTEM.PORTOUT( 3D4H, 1258H); ELSE SYSTEM.PORTOUT( 3D4H, 1358H);		(* bit 4: enable lfb, bit 0,1: size: 0= 64k, 1=1MB, 2= 2MB, 3= 4MB *) END; SYSTEM.PORTOUT( 3D4H, 59H);			(* set base adr for lfb *) SYSTEM.PORTOUT( 3D5H, CHR( ASH( FBPhysAdr, -24) MOD 100H)); SYSTEM.PORTOUT( 3D4H, 5AH); SYSTEM.PORTOUT( 3D5H, CHR( ASH( FBPhysAdr, -16) MOD 100H)); (* 		SYSTEM.PORTOUT( 3D4H, 33H);			(* disable border *) 		SYSTEM.PORTIN( 3D5H, ch); 		SYSTEM.PORTOUT( 3D5H, SYSTEM.VAL( CHAR, SYSTEM.VAL( SET, ch)+{5})); *) END; SYSTEM.PORTOUT( 3C4H, SYSTEM.VAL( INTEGER, 8009H));		(* disable programmed I/O *) Kernel.WriteString("S3Trio: "); Kernel.WriteInt(Width, 1); Kernel.WriteChar("x"); Kernel.WriteInt(Height, 1); CASE truecol OF 		0: Kernel.WriteString(" 8-bit indexed") |1: Kernel.WriteString(" 5,6,5-bit RGB") |2: Kernel.WriteString(" 8,8,8-bit RGB") END; Kernel.WriteString(" (+"); Kernel.WriteInt(-UBottom, 1); 	Kernel.WriteString(" offscreen)"); Kernel.WriteLn END InitS3; BEGIN Left:= 0; ColLeft:= 0; Bottom:= 0; Pat := NIL; InitS3; ResetClip; CreatePatterns; Unit := 10000 END Display. (* #     0103   800  600  256  P8   0 *) (* Compiler.Compile S3Trio.Display.Mod\X ~ *)
 * 1) Trio64 Display settings
 * 1)      0205  1024  768  256  P8   0
 * 2)      0107  1280 1024  256  P8   0
 * 3)      0211   640  480  64k  P16  1
 * 4)      0111   640  480  64k  P16  1
 * 5)      0114   800  600  64k  P16  1
 * 6)      0117  1024  768  64k  P16  1
 * 7)      011A  1280 1024  64k  P16  1
 * 8)      0212   640  480  16m  P24  2
 * 9)      0112   640  480  16m  P32  2
 * 10)      0115   800  600  16m  P32  2
 * 11)      0118  1024  768  16m  P32  2

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
Oberon/ETH Oberon/2.3.7/SVGA.Display.Mod

(* 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;	(* pjm *) (* Native Oberon SVGA display driver, pjm 20.04.98 *) IMPORT SYSTEM, Objects, Kernel; CONST BG* = 0; FG* = 15; replace* = 0;	(** replace destination. *) paint* = 1;	(** paint over destination. *) invert* = 2;	(** invert destination. *) 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; WinSize = 10000H; BufSize = 10000H; VesaAdr = 0E0000000H;	(* where MapVesa=1 maps *) LinearSize = 4*1024*1024;	(* amount to map in *) 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;	(** Base type of all displayable objects. *) FrameDesc* = RECORD (Objects.ObjDesc) next*, dsc*: Frame;	(** Sibling, child pointers. *) X*, Y*, W*, H*: INTEGER	(** Coordinates. *) END; FrameMsg* = RECORD (Objects.ObjMsg)	(** Base type of messages sent to frames. *) F*: Frame; (*target*)	(** Message target, NIL for broadcast. *) x*, y*: INTEGER;	(** Message origin. *) res*: INTEGER	(** Result code: <0 = error or no response, >=0 response. *) END; ControlMsg* = RECORD (FrameMsg) id*: INTEGER	(** remove, suspend, restore. *) END; ModifyMsg* = RECORD (FrameMsg)	(** Change coordinates in container frame. *) id*: INTEGER;	(** reduce, extend, move. *) mode*: INTEGER;	(** Modes display, state. *) dX*, dY*, dW*, dH*: INTEGER;	(** Change from old coordinates (delta). *) X*, Y*, W*, H*: INTEGER	(** New coordinates. *) END; DisplayMsg* = RECORD (FrameMsg)	(** Display a frame, a part of it or its contents. *) device*: INTEGER;	(** screen, printer *) id*: INTEGER;	(** full, area, contents. *) u*, v*, w*, h*: INTEGER	(** Area to be restored. *) END; LocateMsg* = RECORD (FrameMsg)	(** Locate frame in display space. *) loc*: Frame;	(** Result. *) X*, Y*: INTEGER;	(** Absolute location. *) u*, v*: INTEGER	(** Relative coordinates in loc. *) END; SelectMsg* = RECORD (FrameMsg)	(** Selection control. *) id*: INTEGER;	(** get, set, reset. *) time*: LONGINT;	(** Time of selection. *) sel*: Frame;	(** Parent of selection. *) obj*: Objects.Object	(** List of objects involved, linked with slink. *) END; ConsumeMsg* = RECORD (FrameMsg)	(** Drop, integrate frames. *) id*: INTEGER;	(** drop, integrate. *) u*, v*: INTEGER;	(** Relative coordinates in destination when drop. *) obj*: Objects.Object	(** List of objects to be consumed, linked with slink. *) END; MsgProc* = PROCEDURE (VAR M: FrameMsg); SwitchProc = PROCEDURE (bank: LONGINT); Buffer = RECORD bytes: ARRAY BufSize OF CHAR END; VAR Unit*: LONGINT; (** RasterUnit = Unit/36000 mm *) Left*, (** Left margin of black-and-white screen. *) ColLeft*, (** Left margin of secondary display, often same as Left. *) Bottom*, (** Bottom of primary map. *) UBottom*, (** Bottom of offscreen area (negative), 0 if not supported. *) Width*, (** Display width. *) Height*: INTEGER; (** Display height. *) arrow*, 	(** Oberon cursor. *) star*, 	(** Star marker to mark documents and viewers. *) cross*, 	(** Insertion marker. *) downArrow*, 	(** Marker to indicate disk operation. *) hook*,	(** Text caret pattern. *) grey0*, grey1*, grey2*, ticks*, solid*: Pattern;	(** Simulated grey levels. *) Broadcast*: MsgProc;	(** Message broadcast to all frames in the display space. *) palette: ARRAY 256 OF LONGINT; depth: LONGINT; displayWidth, displayHeight, displayHeight1, maxY: LONGINT; clipX1, clipY1, clipX2, clipY2: LONGINT;	(* bottom left corner & top right corner, in Oberon coordinates *) pattern: List; buffer: POINTER TO Buffer; curBank: LONGINT; switch: SwitchProc;	(* switch to window "bank". *) base, linearbase: LONGINT; (* Switch procedures. *) (* SwitchS3Aurora64V - Aurora64V+ in Compaq laptop & Trio64V+ in STB PowerGraph 64 *) PROCEDURE SwitchS3Aurora64V(bank: LONGINT); VAR b: SET; p: LONGINT; BEGIN curBank := bank; SYSTEM.PORTOUT(3C4H, 4X); SYSTEM.PORTIN(3C5H, SYSTEM.VAL(CHAR, b)); IF ~(3 IN b) THEN bank := bank*4 END; SYSTEM.PORTIN(3CCH, SYSTEM.VAL(CHAR, b)); IF 0 IN b THEN p := 3D4H ELSE p := 3B4H END; SYSTEM.PORTOUT(p, SYSTEM.VAL(INTEGER, 4838H)); SYSTEM.PORTOUT(p, SYSTEM.VAL(INTEGER, 0A539H)); SYSTEM.PORTIN(3CCH, SYSTEM.VAL(CHAR, b)); IF 0 IN b THEN p := 3D4H ELSE p := 3B4H END; SYSTEM.PORTOUT(p, 6AX); SYSTEM.PORTIN(p+1, SYSTEM.VAL(CHAR, b)); b := SYSTEM.LSH((b * {6,7}) + SYSTEM.VAL(SET, bank), 8) + SYSTEM.VAL(SET, 6AH); SYSTEM.PORTOUT(p, SYSTEM.VAL(INTEGER, b)) END SwitchS3Aurora64V; (* SwitchET4000 - ET4000 (vgadoc) *) PROCEDURE SwitchET4000(bank: LONGINT); BEGIN curBank := bank; SYSTEM.PORTOUT(3CDH, CHR(bank MOD 16 * 16 + bank MOD 16))	(* 64k r/w bank *) END SwitchET4000; (* SwitchS3801 - S3 801/5 & 928 (vgadoc) *) PROCEDURE SwitchS3801(bank: LONGINT); VAR s: SET; BEGIN curBank := bank; SYSTEM.PORTOUT(3D4H, 35X); SYSTEM.PORTIN(3D5H, SYSTEM.VAL(CHAR, s)); SYSTEM.PORTOUT(3D4H, SYSTEM.VAL(INTEGER, SYSTEM.LSH(s * {4..7} + 		SYSTEM.VAL(SET, bank MOD 16), 8) + SYSTEM.VAL(SET, 35H))); SYSTEM.PORTOUT(3D4H, 51X); SYSTEM.PORTIN(3D5H, SYSTEM.VAL(CHAR, s)); SYSTEM.PORTOUT(3D4H, SYSTEM.VAL(INTEGER, SYSTEM.LSH(s * {0..1, 4..7} + 		SYSTEM.VAL(SET, ASH(bank DIV 16, 2)), 8) + SYSTEM.VAL(SET, 51H))) END SwitchS3801; (* SwitchFireGL - Diamond FireGL (512k only). *) PROCEDURE SwitchFireGL(bank: LONGINT); VAR s: SET; save: CHAR; BEGIN curBank := bank; SYSTEM.PORTIN(3CEH, save); SYSTEM.PORTOUT(3CEH, 9X); SYSTEM.PORTIN(3CFH, SYSTEM.VAL(CHAR, s)); SYSTEM.PORTOUT(3CFH, SYSTEM.VAL(CHAR, s - {0..2} + SYSTEM.VAL(SET, bank) * {0..2})); SYSTEM.PORTOUT(3CEH, save) END SwitchFireGL; (* SwitchGD542x - Cirrus Logic 542x (Gitsels' machine). *) PROCEDURE SwitchGD542x(bank: LONGINT); VAR a: ARRAY 5 OF CHAR; BEGIN curBank := bank; SYSTEM.PORTIN(3C4H, a[0]); SYSTEM.PORTIN(3D4H, a[1]); SYSTEM.PORTIN(3B4H, a[2]); SYSTEM.PORTIN(3CEH, a[3]); SYSTEM.PORTIN(3CEH, a[4]); SYSTEM.PORTOUT(3CEH, SHORT(ASH(16*bank, 8) + 9)); SYSTEM.PORTOUT(3CEH, a[4]); SYSTEM.PORTIN(3CEH, a[3]); SYSTEM.PORTIN(3B4H, a[2]); SYSTEM.PORTIN(3D4H, a[1]); SYSTEM.PORTIN(3C4H, a[0]) END SwitchGD542x; (* SwitchMach32 - ATI Mach32 family. *) PROCEDURE SwitchMach32(bank: LONGINT); VAR s: SET; BEGIN curBank := bank; s := SYSTEM.VAL(SET, (bank MOD 16) * 22H); SYSTEM.PORTOUT(1CEH, 0B2X); SYSTEM.PORTOUT(1CFH, SYSTEM.VAL(CHAR, SYSTEM.LSH(s, -8) + (s * {0..7}))); SYSTEM.PORTOUT(1CEH, 0AEX); SYSTEM.PORTIN(1CFH, SYSTEM.VAL(CHAR, s)); SYSTEM.PORTOUT(1CEH, 0AEX); SYSTEM.PORTOUT(1CFH, SYSTEM.VAL(CHAR, (s * {4..7}) + SYSTEM.VAL(SET, ASH(bank, -4)*5))) END SwitchMach32; (* SwitchTrident9xxx - Back switch procedure for Trident 9xxx family - 9000C and higher 	Harold L. Weaver   	Tested on IBM Thinkpad 760ED with a Trident Cyber9385 *) PROCEDURE SwitchTrident9xxx(bank: LONGINT); BEGIN curBank := bank; SYSTEM.PORTOUT(3D8H, CHR(bank)); SYSTEM.PORTOUT(3D9H, CHR(bank)) END SwitchTrident9xxx; (* SwitchLinear - Switch to fixed linear aperture *) PROCEDURE SwitchLinear(bank: LONGINT); BEGIN curBank := bank; base := linearbase + WinSize*bank END SwitchLinear; (** Change color palette entry. 0 <= col, red, green, blue < 256. *) PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT); 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; (** Retrieve color palette entry or color components. 0 <= red, green, blue < 256. *) 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; (** Return color with specified components. 0 <= red, green, blue < 256. *) PROCEDURE RGB*(red, green, blue: LONGINT): Color; BEGIN RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue END RGB; (** Returns the number of bits per pixel for the given x coordinate. Typical values are 1, 4, 8, 24. *) PROCEDURE Depth*(x: LONGINT): INTEGER; BEGIN RETURN SHORT(depth) END Depth; PROCEDURE TrueColor*(x: LONGINT): BOOLEAN; BEGIN RETURN FALSE END TrueColor; (** Get the current clip rectangle. *) PROCEDURE GetClip*(VAR x, y, w, h: INTEGER); BEGIN x := SHORT(clipX1); y := SHORT(clipY1); w := SHORT(clipX2-clipX1+1); h := SHORT(clipY2-clipY1+1) END GetClip; (** Set the new clipping rectangle. *) PROCEDURE SetClip*(x, y, w, h: LONGINT); BEGIN clipX1 := x; clipY1 := y; 	clipX2 := clipX1+w-1;  clipY2 := clipY1+h-1 END SetClip; (** Intersect with current clip rectangle resulting in a new clip rectangle. *) PROCEDURE AdjustClip*(x, y, w, h: LONGINT); VAR x2, y2: LONGINT; BEGIN x2 := x + w - 1; y2 := y + h - 1; IF x > clipX1 THEN clipX1 := x END; IF y > clipY1 THEN clipY1 := y END; IF x2 < clipX2 THEN clipX2 := x2 END; IF y2 < clipY2 THEN clipY2 := y2 END END AdjustClip; (** Reset the current clipping rectangle to the whole display, including offscreen area. *) PROCEDURE ResetClip*; BEGIN clipX1 := 0; clipY1 := UBottom; clipX2 := displayWidth-1; clipY2 := maxY END ResetClip; (* CopyAlignDst - Like SYSTEM.MOVE, but aligns destination 4-byte values in inner loop. *) PROCEDURE CopyAlignDst(src, dst, size: LONGINT); CODE {SYSTEM.i386} MOV ESI, src[EBP] MOV EDI, dst[EBP] MOV ECX, size[EBP] CLD TEST ECX, ECX JZ exit TEST EDI, 4 JZ ok 	MOVSB DEC ECX JZ exit TEST EDI, 4 JZ ok 	MOVSB DEC ECX JZ exit TEST EDI, 4 JZ ok 	MOVSB DEC ECX JZ exit ok: MOV EAX, ECX SHR ECX, 2	; size DIV 4 AND EAX, 3	; size MOD 4 REP MOVSD MOV ECX, EAX REP MOVSB exit: END CopyAlignDst; (* CopyAlignSrc - Like SYSTEM.MOVE, but aligns source to 4-byte values in inner loop. *) PROCEDURE CopyAlignSrc(src, dst, size: LONGINT); CODE {SYSTEM.i386} MOV ESI, src[EBP] MOV EDI, dst[EBP] MOV ECX, size[EBP] CLD TEST ECX, ECX JZ exit TEST ESI, 4 JZ ok 	MOVSB DEC ECX JZ exit TEST ESI, 4 JZ ok 	MOVSB DEC ECX JZ exit TEST ESI, 4 JZ ok 	MOVSB DEC ECX JZ exit ok: MOV EAX, ECX SHR ECX, 2	; size DIV 4 AND EAX, 3	; size MOD 4 REP MOVSD MOV ECX, EAX REP MOVSB exit: END CopyAlignSrc; PROCEDURE CopyBlock0(n, w, adr, buf: LONGINT; from: BOOLEAN); VAR bank, ofs, left, h0: LONGINT; BEGIN REPEAT bank := adr DIV WinSize; ofs := adr MOD WinSize; IF bank # curBank THEN switch(bank) END; left := WinSize - ofs; h0 := left DIV displayWidth;	(* h0 = lines that will fit in window *) IF h0 > n THEN h0 := n 		ELSIF (h0 = 0) & (left >= w) THEN h0 := 1 END; INC(ofs, base); IF h0 # 0 THEN INC(adr, h0*displayWidth); DEC(n, h0); REPEAT IF from THEN CopyAlignSrc(ofs, buf, w) ELSE CopyAlignDst(buf, ofs, w) END; DEC(h0); INC(ofs, displayWidth);  INC(buf, w) 			UNTIL h0 = 0 ELSE	(* h0 = 0 *) INC(adr, displayWidth); DEC(n); IF from THEN CopyAlignSrc(ofs, buf, left) ELSE CopyAlignDst(buf, ofs, left) END; switch(bank+1); IF from THEN CopyAlignSrc(base, buf+left, w-left) ELSE CopyAlignDst(buf+left, base, w-left) END; INC(buf, w) 		END UNTIL n = 0 END CopyBlock0; (** Copy source block sx, sy, w, h to destination dx, dy using operation mode. A block is given by its lower left corner sx, sy and its dimension w, h. Some drivers only implement mode = replace. *) PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); VAR w0, h0, dx0, dy0, src, dst, n, bufLines: LONGINT; BEGIN	(* only the destination block is clipped *) w0 := w; h0 := h;  dx0 := dx;  dy0 := dy; IF dx < clipX1 THEN dx := clipX1; DEC(w, dx-dx0) END; IF dy < clipY1 THEN dy := clipY1; DEC(h, dy-dy0) END; IF (w > 0) & (h > 0) & (w <= w0) & (h <= h0) THEN IF dx+w-1 > clipX2 THEN DEC(w, dx+w-1 - clipX2) END; IF dy+h-1 > clipY2 THEN DEC(h, dy+h-1 - clipY2) END; IF (w > 0) & (h > 0) & (w <= w0) & (h <= h0) THEN sy := maxY-sy-h+1; dy := maxY-dy-h+1;	(* convert to screen coordinates *) src := sy*displayWidth + sx; dst := dy*displayWidth + dx; bufLines := BufSize DIV w;	(* lines to copy at a time *) IF bufLines > h THEN bufLines := h END; (* adjust direction for overlap *) IF (dy-h+1 < sy) & (sy < dy) THEN	(* start at bottom *) n := displayWidth*(h-bufLines); INC(src, n); INC(dst, n); REPEAT CopyBlock0(bufLines, w, src, SYSTEM.ADR(buffer.bytes[0]), TRUE); CopyBlock0(bufLines, w, dst, SYSTEM.ADR(buffer.bytes[0]), FALSE); DEC(h, bufLines); IF bufLines > h THEN bufLines := h END; n := bufLines*displayWidth; DEC(src, n); DEC(dst, n) 				UNTIL h = 0 ELSE	(* start at top *) n := bufLines*displayWidth; REPEAT CopyBlock0(bufLines, w, src, SYSTEM.ADR(buffer.bytes[0]), TRUE); CopyBlock0(bufLines, w, dst, SYSTEM.ADR(buffer.bytes[0]), FALSE); INC(src, n); INC(dst, n); DEC(h, bufLines); IF bufLines > h THEN bufLines := h END UNTIL h = 0 END END END END CopyBlock; (* CopyPattern0 - Copy pixels from src to dst, with no clipping. ofs is the pixel offset to start at (max 7).  src is the  pattern source address.  dst is the screen destination address.  w is the number of pixels to copy (max pat.w).   col & mode are the colour and mode respectively. *) PROCEDURE CopyPattern0(ofs, src, dst, w, col, mode: LONGINT); VAR ch: CHAR; m, i: LONGINT;  s: SET; BEGIN REPEAT	(* loop over w pixels *) SYSTEM.GET(src, ch); i := ofs;	(* start bit *) m := 8;	(* stop bit *) IF m > ofs+w THEN m := ofs+w END; REPEAT	(* loop over bits *) (*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H));*) IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *) IF mode = invert THEN SYSTEM.GET(dst, SYSTEM.VAL(CHAR, s)); SYSTEM.PUT(dst, SYSTEM.VAL(CHAR, SYSTEM.VAL(SET, col) / s)) ELSE	(* paint & replace *) SYSTEM.PUT(dst, CHR(col)) END ELSIF mode = replace THEN	(* pixel off *) SYSTEM.PUT(dst, CHR(BG)) ELSE (* skip *) END; INC(dst); INC(i) UNTIL i = m; 		INC(src); DEC(w, m-ofs);  ofs := 0 UNTIL w = 0 END CopyPattern0; (* CopyPattern1 - Copy pixels from src (x,y), with full clipping. Slower version of CopyPattern0, with individual clipping of every pixel.  ofs is always 0.  (x,y) is the screen destination. *) PROCEDURE CopyPattern1(src, x, y, w, col, mode: LONGINT); VAR ch: CHAR; m, i: LONGINT; BEGIN REPEAT	(* loop over w pixels *) SYSTEM.GET(src, ch); i := 0;	(* start bit *) m := 8;	(* stop bit *) IF m > w THEN m := w END; REPEAT	(* loop over bits *) IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *) Dot(SHORT(col), SHORT(x), SHORT(y), SHORT(mode)) ELSIF mode = replace THEN	(* pixel off *) Dot(BG, SHORT(x), SHORT(y), replace) ELSE (* skip *) END; INC(x); INC(i) UNTIL i = m; 		INC(src); DEC(w, m) 	UNTIL w = 0 END CopyPattern1; (** Copy pattern pat in color col to x, y using operation mode. *) PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT); VAR x2, y2, w, w0, h, src, dst, bank, left, h0: LONGINT; ch: CHAR; BEGIN SYSTEM.GET(pat, ch); w := ORD(ch); SYSTEM.GET(pat+1, ch); h := ORD(ch); IF (w > 0) & (h > 0) THEN x2 := x+w-1; y2 := y+h-1;	(* (x,y) bottom left & (x2,y2) top right *) IF (x >= clipX1) & (y >= clipY1) & (x2 <= clipX2) & (y2 <= clipY2) THEN	(* fully visible - common case *) w0 := (w+7) DIV 8;	(* bytes in pattern line *) src := pat+2 + (h-1)*w0;	(* last line of pattern *) y := maxY-y-h+1;	(* convert to screen coordinate *) REPEAT	(* loop over h lines *) dst := y * displayWidth + x; 				bank := dst DIV WinSize; dst := dst MOD WinSize; IF bank # curBank THEN switch(bank) END; left := WinSize - dst; h0 := left DIV displayWidth;	(* h0 = lines that will fit in window *) IF h0 > h THEN h0 := h 				ELSIF (h0 = 0) & (left >= w) THEN h0 := 1 END; INC(dst, base); IF h0 # 0 THEN INC(y, h0); DEC(h, h0); REPEAT	(* loop over h0 lines, without bank crossing *) CopyPattern0(0, src, dst, w, col, mode); DEC(h0); INC(dst, displayWidth);  DEC(src, w0) UNTIL h0 = 0 ELSE	(* h0 = 0 *) CopyPattern0(0, src, dst, left, col, mode); switch(bank+1); CopyPattern0(left MOD 8, src + left DIV 8, base, w-left, col, mode); INC(y); DEC(src, w0);  DEC(h) END UNTIL h = 0 ELSIF (x2 >= clipX1) & (y2 >= clipY1) & (x <= clipX2) & (y <= clipY2) THEN	(* partially visible *) w0 := (w+7) DIV 8;	(* bytes in pattern line *) src := pat+2;	(* last line of pattern *) REPEAT	(* loop over h lines *) CopyPattern1(src, x, y, w, col, mode); INC(y); INC(src, w0);  DEC(h) UNTIL h = 0 ELSE (* invisible *) END END END CopyPattern; (* FillPattern0 - Copy pixels from src to dst, with no clipping, with wraparound in the source. ofs is the pixel offset to  start at.  src is the pattern source address.  dst is the screen destination address.  w is the number of pixels to copy.   pw is the pattern width.  col & mode are the colour and mode respectively. *) PROCEDURE FillPattern0(ofs, src, dst, w, pw, col, mode: LONGINT); VAR ch: CHAR; m, i, src0, left: LONGINT;  s: SET; BEGIN left := pw-ofs;	(* pixels left to do in pattern *) src0 := src; INC(src, ofs DIV 8);  ofs := ofs MOD 8;	(* start position *) REPEAT	(* loop over w pixels *) SYSTEM.GET(src, ch); i := ofs;	(* start bit *) m := 8;	(* stop bit *) IF m > ofs+left THEN m := ofs+left END;	(* max left times *) IF m > ofs+w THEN m := ofs+w END;	(* max w times *) REPEAT	(* loop over bits *) (*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H));*) IF ODD(ASH(ORD(ch), -i)) THEN	(* pixel on *) IF mode = invert THEN SYSTEM.GET(dst, SYSTEM.VAL(CHAR, s)); SYSTEM.PUT(dst, SYSTEM.VAL(CHAR, SYSTEM.VAL(SET, col) / s)) ELSE	(* paint & replace *) SYSTEM.PUT(dst, CHR(col)) END ELSIF mode = replace THEN	(* pixel off *) SYSTEM.PUT(dst, CHR(BG)) ELSE (* skip *) END; INC(dst); INC(i) UNTIL i = m; 		INC(src); DEC(left, m-ofs);  DEC(w, m-ofs);  ofs := 0; IF left = 0 THEN src := src0; left := pw END	(* wrap to start of pattern *) UNTIL w = 0 END FillPattern0; (** Replicate pattern pat in color col into block x, y, w, h using operation mode, proceeding from left to right and from bottom to top, starting at lower left corner. The pattern origin is placed at px, py. *) PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); VAR pw, ph, x2, y2, w0, src0, src, dst, bank, left, h0: LONGINT; ch: CHAR; BEGIN x2 := x+w-1; y2 := y+h-1;	(* (x,y) bottom left & (x2,y2) top right *) IF x < clipX1 THEN DEC(w, clipX1-x); x := clipX1 ELSIF x > clipX2 THEN DEC(w, x-clipX2); x := clipX2 END; IF y < clipY1 THEN DEC(h, clipY1-y); y := clipY1 ELSIF y > clipY2 THEN DEC(h, y-clipY2); y := clipY2 END; IF x2 < clipX1 THEN DEC(w, clipX1-x2) ELSIF x2 > clipX2 THEN DEC(w, x2-clipX2) END; IF y2 < clipY1 THEN DEC(h, clipY1-y2) ELSIF y2 > clipY2 THEN DEC(h, y2-clipY2) END; IF (w > 0) & (h > 0) THEN SYSTEM.GET(pat, ch); pw := ORD(ch); SYSTEM.GET(pat+1, ch); ph := ORD(ch); IF (pw > 0) & (ph > 0) THEN INC(pat, 2);	(* adr of bitmap *) w0 := (pw+7) DIV 8;	(* bytes in pattern line *) src0 := pat + (ph-1)*w0;	(* last line of pattern *) src := pat + (h-1 + y-py) MOD ph * w0;	(* start line of pattern *) px := (x - px) MOD pw;	(* start pixel offset *) y := maxY-y-h+1;	(* convert to screen coordinate *) REPEAT	(* loop over h lines *) dst := y * displayWidth + x; 				bank := dst DIV WinSize; dst := dst MOD WinSize; IF bank # curBank THEN switch(bank) END; left := WinSize - dst; h0 := left DIV displayWidth;	(* h0 = lines that will fit in window *) IF h0 > h THEN h0 := h 				ELSIF (h0 = 0) & (left >= w) THEN h0 := 1 END; INC(dst, base); IF h0 # 0 THEN INC(y, h0); DEC(h, h0); REPEAT	(* loop over h0 lines, without bank crossing *) FillPattern0(px, src, dst, w, pw, col, mode); DEC(h0); INC(dst, displayWidth); IF src = pat THEN src := src0 ELSE DEC(src, w0) END UNTIL h0 = 0 ELSE	(* h0 = 0 *) FillPattern0(px, src, dst, left, pw, col, mode); switch(bank+1); FillPattern0((px + left) MOD pw, src, base, w-left, pw, col, mode); INC(y); DEC(h); IF src = pat THEN src := src0 ELSE DEC(src, w0) END END UNTIL h = 0 END END END FillPattern; (** Like FillPattern, but the pattern origin is placed at 0, 0. *) 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; (* ReplConst0 - Replicate a constant in a line in replace mode. *) PROCEDURE ReplConst0(dst, w, cols: LONGINT); BEGIN (*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H)); 	ASSERT((w >= 0) & (w <= displayWidth));*) WHILE (dst MOD 4 # 0) & (w # 0) DO 		SYSTEM.PUT(dst, CHR(cols)); INC(dst); DEC(w) END; WHILE w >= 4 DO 		SYSTEM.PUT(dst, cols); INC(dst, 4); DEC(w, 4) END; WHILE w # 0 DO 		SYSTEM.PUT(dst, CHR(cols)); INC(dst); DEC(w) END END ReplConst0; (* ReplConst2 - Replicate a constant in a line in invert mode. *) PROCEDURE ReplConst2(dst, w, cols: LONGINT); VAR s: SET; left, right: LONGINT;  t: ARRAY 4 OF SET; BEGIN (*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H)); 	ASSERT((w >= 0) & (w <= displayWidth));*) IF w > 0 THEN left := dst MOD 4; DEC(dst, left); INC(w, left); right := w MOD 4; IF w < 4 THEN SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (SYSTEM.VAL(SET, cols) * {left*8..31} * {0..right*8-1})) ELSE	(* w >= 4 *) DEC(w, right); SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (SYSTEM.VAL(SET, cols) * {left*8..31})); INC(dst, 4); DEC(w, 4); WHILE w >= 16 DO	(* unrolled loop *) SYSTEM.GET(dst, t[0]); SYSTEM.GET(dst+4, t[1]); SYSTEM.GET(dst+8, t[2]); SYSTEM.GET(dst+12, t[3]); SYSTEM.PUT(dst, t[0] / SYSTEM.VAL(SET, cols)); SYSTEM.PUT(dst+4, t[1] / SYSTEM.VAL(SET, cols)); SYSTEM.PUT(dst+8, t[2] / SYSTEM.VAL(SET, cols)); SYSTEM.PUT(dst+12, t[3] / SYSTEM.VAL(SET, cols)); INC(dst, 16); DEC(w, 16) END; WHILE w > 0 DO 				SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / SYSTEM.VAL(SET, cols)); INC(dst, 4); DEC(w, 4) END; IF right > 0 THEN SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (SYSTEM.VAL(SET, cols) * {0..right*8-1})) END END END END ReplConst2; (** Block fill in color col and operation mode. mode paint and replace are equivalent. *) PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); VAR cols, dst, left, x2, y2, h0, bank: LONGINT; BEGIN x2 := x+w-1; y2 := y+h-1;	(* (x2,y2) is top right corner *) cols := col MOD 100H; cols := ASH(cols, 24) + ASH(cols, 16) + ASH(cols, 8) + cols; IF x < clipX1 THEN DEC(w, clipX1-x); x := clipX1 ELSIF x > clipX2 THEN DEC(w, x-clipX2); x := clipX2 END; IF y < clipY1 THEN DEC(h, clipY1-y); y := clipY1 ELSIF y > clipY2 THEN DEC(h, y-clipY2); y := clipY2 END; IF x2 < clipX1 THEN DEC(w, clipX1-x2) ELSIF x2 > clipX2 THEN DEC(w, x2-clipX2) END; IF y2 < clipY1 THEN DEC(h, clipY1-y2) ELSIF y2 > clipY2 THEN DEC(h, y2-clipY2) END; IF (w > 0) & (h > 0) THEN y := maxY-y-h+1;	(* convert to screen coordinate *) REPEAT dst := y * displayWidth + x; 			bank := dst DIV WinSize; dst := dst MOD WinSize; IF bank # curBank THEN switch(bank) END; left := WinSize - dst; h0 := left DIV displayWidth;	(* h0 = lines that will fit in window *) IF h0 > h THEN h0 := h 			ELSIF (h0 = 0) & (left >= w) THEN h0 := 1 END; INC(dst, base); IF h0 # 0 THEN INC(y, h0); DEC(h, h0); REPEAT IF mode = invert THEN ReplConst2(dst, w, cols) ELSE ReplConst0(dst, w, cols) END; DEC(h0); INC(dst, displayWidth) UNTIL h0 = 0 ELSE	(* h0 = 0 *) IF mode = invert THEN ReplConst2(dst, left, cols) ELSE ReplConst0(dst, left, cols) END; switch(bank+1); IF mode = invert THEN ReplConst2(base, w-left, cols) ELSE ReplConst0(base, w-left, cols) END; INC(y); DEC(h) END UNTIL h = 0 END END ReplConst; (** Place a dot of color col in operation mode at x, y. Effect equivalent to ReplConst with a block of size 1, 1. *) PROCEDURE Dot*(col: Color; x, y, mode: LONGINT); VAR dst, bank: LONGINT; s: SET; BEGIN IF (x >= clipX1) & (x <= clipX2) & (y >= clipY1) & (y <= clipY2) THEN dst := (maxY-y) * displayWidth + x; 		bank := dst DIV WinSize; dst := dst MOD WinSize; IF bank # curBank THEN switch(bank) END; INC(dst, base); IF mode = invert THEN SYSTEM.GET(dst, SYSTEM.VAL(CHAR, s)); SYSTEM.PUT(dst, SYSTEM.VAL(CHAR, SYSTEM.VAL(SET, col) / s)) ELSE SYSTEM.PUT(dst, CHR(col)) END END END Dot; (** Returns the dimensions of a pattern. *) PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER); VAR ch: CHAR; BEGIN SYSTEM.GET(pat, ch); w := ORD(ch); SYSTEM.GET(pat+1, ch); h := ORD(ch) END GetDim; (** Define a new pattern. *) 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; (* Define standard patterns. *) 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; (** Return the format of a display region, for TransferBlock. *) PROCEDURE TransferFormat*(x: LONGINT): LONGINT; BEGIN RETURN unknown END TransferFormat; (** Transfer a block of pixels in display format to (mode = set) or from (mode = get) the display.  Pixels in the rectangular area are transferred from bottom to top and left to right.  The pixels are transferred to or from buf, starting at ofs, and with line increment stride, which may be < 0. *) PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT); BEGIN HALT(99) END TransferBlock; (** Change screen mode. *) PROCEDURE SetMode*(x: LONGINT; s: SET); BEGIN END SetMode; (* DisplayBlock0 - Display a line in replace mode. *) PROCEDURE DisplayBlock0(src, dst, w: LONGINT); CODE {SYSTEM.i386} MOV ESI, src[EBP] MOV EDI, dst[EBP] MOV EDX, w[EBP] while00: TEST EDI, 3 JZ while01 CMP EDX, 0 JE exit MOV AL, [ESI] MOV [EDI], AL 	INC ESI INC EDI DEC EDX JMP while00 while01: CMP EDX, 4 JL while21 MOV EAX, [ESI] MOV [EDI], EAX ADD ESI, 4 ADD EDI, 4 SUB EDX, 4 JG while01 while21: CMP EDX, 0 JE exit while20: MOV AL, [ESI] MOV [EDI], AL 	INC ESI INC EDI DEC EDX JNZ while20 exit: END DisplayBlock0; (* PROCEDURE DisplayBlock0(src, dst, w: LONGINT); VAR ch: CHAR; s: SET; BEGIN 	(*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H)); ASSERT((w >= 0) & (w <= displayWidth));*) 	WHILE (dst MOD 4 # 0) & (w # 0) DO 		SYSTEM.GET(src, ch); 		SYSTEM.PUT(dst, ch); 		INC(src); INC(dst);  DEC(w) 	END; 	WHILE w >= 4 DO 		SYSTEM.GET(src, s); 		SYSTEM.PUT(dst, s); 		INC(src, 4);  INC(dst, 4);  DEC(w, 4) 	END; 	WHILE w # 0 DO 		SYSTEM.GET(src, ch); 		SYSTEM.PUT(dst, ch); 		INC(src);  INC(dst);  DEC(w) 	END END DisplayBlock0; *) (* DisplayBlock2 - Display a line in invert mode. *) PROCEDURE DisplayBlock2(src, dst, w: LONGINT); VAR s, t: SET; left, right: LONGINT; BEGIN (*ASSERT((base # 0A0000H) OR (dst >= 0A0000H) & (dst < 0B0000H)); 	ASSERT((w >= 0) & (w <= displayWidth));*) IF w > 0 THEN left := dst MOD 4; DEC(dst, left); DEC(src, left);  INC(w, left); right := w MOD 4; IF w < 4 THEN SYSTEM.GET(src, t); SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (t * {left*8..31} * {0..right*8-1})) ELSE	(* w >= 4 *) DEC(w, right); SYSTEM.GET(src, t); SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (t * {left*8..31})); INC(dst, 4); INC(src, 4);  DEC(w, 4); WHILE w > 0 DO 				SYSTEM.GET(src, t); SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / t); INC(dst, 4); INC(src, 4);  DEC(w, 4) END; IF right > 0 THEN SYSTEM.GET(src, t); SYSTEM.GET(dst, s); SYSTEM.PUT(dst, s / (t * {0..right*8-1})) END END END END DisplayBlock2; (** Display a picture. Used internally by Pictures module only. *) PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT); VAR pw, pd, x, y, h0, src, x2, y2, dst, bank, left: LONGINT; BEGIN x := sx; y := sy; x2 := x+w-1; y2 := y+h-1;	(* (x2,y2) is top right corner *) IF x < clipX1 THEN DEC(w, clipX1-x); INC(dx, clipX1-x);  x := clipX1 ELSIF x > clipX2 THEN DEC(w, x-clipX2) END; IF y < clipY1 THEN DEC(h, clipY1-y); INC(dy, clipY1-y);  y := clipY1 ELSIF y > clipY2 THEN DEC(h, y-clipY2) END; IF x2 < clipX1 THEN DEC(w, clipX1-x2) ELSIF x2 > clipX2 THEN DEC(w, x2-clipX2) END; IF y2 < clipY1 THEN DEC(h, clipY1-y2) ELSIF y2 > clipY2 THEN DEC(h, y2-clipY2) END; IF (w > 0) & (h > 0) THEN pd := 0; SYSTEM.GET(adr+4, SYSTEM.VAL(INTEGER, pd)); IF pd = 8 THEN SYSTEM.GET(adr+8, pw); SYSTEM.GET(adr+12, src); INC(src, (dy+h-1)*pw + dx);	(* top left corner *) y := maxY-y-h+1;	(* convert to screen coordinate *) REPEAT dst := y*displayWidth + x; 				bank := dst DIV WinSize; dst := dst MOD WinSize; IF bank # curBank THEN switch(bank) END; left := WinSize - dst; h0 := left DIV displayWidth;	(* h0 = lines that will fit in window *) IF h0 > h THEN h0 := h 				ELSIF (h0 = 0) & (left >= w) THEN h0 := 1 END; INC(dst, base); IF h0 # 0 THEN INC(y, h0); DEC(h, h0); REPEAT IF mode = invert THEN DisplayBlock2(src, dst, w) ELSE DisplayBlock0(src, dst, w) END; DEC(h0); DEC(src, pw);  INC(dst, displayWidth) UNTIL h0 = 0 ELSE	(* h0 = 0 *) IF mode = invert THEN DisplayBlock2(src, dst, left) ELSE DisplayBlock0(src, dst, left) END; switch(bank+1); IF mode = invert THEN DisplayBlock2(src+left, base, w-left) ELSE DisplayBlock0(src+left, base, w-left) END; INC(y); DEC(h) END UNTIL h = 0 ELSE	(* depth not supported *) ReplConst(3, sx, sy, w, h, mode) END END END DisplayBlock; (** Return address of display located at x, or 0 if not supported. *) PROCEDURE Map*(x: LONGINT): LONGINT; BEGIN IF linearbase = 0 THEN RETURN base ELSE RETURN linearbase END END Map; (* 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; (* MapFrameBuffer - Map linear frame buffer. *) PROCEDURE MapFrameBuffer(VAR virtAdr: LONGINT); VAR s: ARRAY 16 OF CHAR; p, physAdr: LONGINT; BEGIN Kernel.GetConfig("DLinBuf", s); IF s[0] = 0X THEN Kernel.GetInit(1, physAdr)	(* get DX:CX from Init string *) ELSE p := 0; physAdr := StrToInt(p, s) 	END; Kernel.MapPhysical(physAdr, LinearSize, virtAdr) END MapFrameBuffer; (* Init - Initialize the screen dimensions. *) PROCEDURE Init; VAR chipSet, mem: LONGINT; BEGIN Kernel.WriteString("SVGA: "); base := 0A0000H; linearbase := 0; chipSet := GetVal("SVGA", 0); CASE chipSet OF 		1: switch := SwitchS3Aurora64V; Kernel.WriteString("S3 Aurora") |2: switch := SwitchET4000; Kernel.WriteString("ET4000") |3: switch := SwitchS3801; Kernel.WriteString("S3-801/5"); SYSTEM.PORTOUT(3D4H, SYSTEM.VAL(INTEGER, 4838H));	(* unlock 1 *) SYSTEM.PORTOUT(3D4H, SYSTEM.VAL(INTEGER, 0A539H))	(* unlock 2 *) |4: switch := SwitchFireGL; Kernel.WriteString("Diamond FireGL") |5: switch := SwitchGD542x; Kernel.WriteString("Cirrus Logic GD542x") |6: switch := SwitchLinear; Kernel.WriteString("Linear frame buffer at"); MapFrameBuffer(linearbase); Kernel.WriteHex(linearbase, 9) |7: switch := SwitchMach32; Kernel.WriteString("ATI Mach32") |8: switch := SwitchTrident9xxx; Kernel.WriteString("Trident9xxx") ELSE switch := SwitchLinear; Kernel.WriteString("Vesa Linear frame buffer at"); linearbase := VesaAdr; Kernel.WriteHex(linearbase, 9) 	(* used with MapVesa=1 *) END; displayWidth := GetVal("DWidth", 1024);	(* assume 1024 if not specified *) displayHeight := 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 displayWidth*displayHeight >= mem DO mem := mem*2 END END; displayHeight1 := mem DIV displayWidth;	(* maximum lines in display memory *) maxY := displayHeight-1; Kernel.WriteChar(" "); Kernel.WriteInt(displayWidth, 1); Kernel.WriteChar("x"); Kernel.WriteInt(displayHeight, 1); Kernel.WriteString(" (+"); Kernel.WriteInt(displayHeight1-displayHeight, 1); 	Kernel.WriteString(" offscreen)"); Kernel.WriteLn END Init; BEGIN curBank := -1; NEW(buffer); Init; Unit := 10000; Left := 0; ColLeft := 0; Bottom := 0; UBottom := SHORT(displayHeight-displayHeight1+1); Width := SHORT(displayWidth); Height := SHORT(maxY+1); pattern := NIL; CreatePatterns; ResetClip END Display. (* Display=SVGA. S3 Aurora64 800x600x8 (S3 Aurora Aurora64V+ in Compaq laptop & Trio64V+ in STB PowerGraph 64) 	Init=bb0301b8024fcd10ba00e0b90000 	SVGA=1 	DWidth=800 DHeight=600 ET4000 (Dell) 1024x768x8 	Init=b83800cd10 	SVGA=2 S3 801/805 (Dell/Quadtel) 1024x768x8 	Init=bb0501b8024fcd10 	SVGA=3 Diamond FireGL1000 Pro with 3DLabs PerMedia 640x480x8 	Init=bb0101b8024fcd10 	SVGA=4 Cirrus Logic GD542x 1024x768x8 	Init=bb0501b8024fcd10 	SVGA=5 Linear frame buffer 	Init=... (set DX:CX) 	SVGA=6 	DLinBuf=physical frame buffer address (or specify DX:CX in Init string) ATI Mach32 	Init=b86400cd10 	SVGA=7 Trident 9xxx 1024x768x8 	Init=bb0501b8024fcd10 	SVGA=8 Compiler.Compile SVGA.Display.Mod\X ~ *) TestSVGA.Mod