MODULE ObxScroll;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
IMPORT Stores, Fonts, Ports, Views, Controllers, Properties;
CONST
minVersion = 0; maxVersion = 0;
cellSize = 7 * Ports.mm;
boardSize = 10;
TYPE
View = POINTER TO RECORD (Views.View)
x, y: INTEGER
END;
PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
BEGIN
wr.WriteVersion(maxVersion);
wr.WriteInt(v.x); wr.WriteInt(v.y)
END Externalize;
PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
VAR version: INTEGER;
BEGIN
rd.ReadVersion(minVersion, maxVersion, version);
IF ~rd.cancelled THEN
rd.ReadInt(v.x); rd.ReadInt(v.y)
END
END Internalize;
PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
BEGIN
WITH source: View DO
v.x := source.x; v.y := source.y
END
END CopyFromSimpleView;
PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
VAR x, y, asc, dsc, w: INTEGER; color: Ports.Color; str: ARRAY 3 OF CHAR; font: Fonts.Font;
BEGIN
str := "00"; font := Fonts.dir.Default();
x := l DIV cellSize;
IF Views.IsPrinterFrame(f) THEN r := r - r MOD cellSize END;
WHILE (x * cellSize < r) & (v.x + x < boardSize) DO
y := t DIV cellSize;
IF Views.IsPrinterFrame(f) THEN b := b - b MOD cellSize END;
WHILE (y * cellSize < b) & (v.y + y < boardSize) DO
IF ODD(x + y + v.x + v.y) THEN color := Ports.black ELSE color := Ports.white END;
f.DrawRect(x * cellSize, y * cellSize, (x + 1) * cellSize, (y + 1) * cellSize, Ports.fill, color);
str[0] := CHR(ORD("0") + x + v.x); str[1] := CHR(ORD("0") + y + v.y);
font.GetBounds(asc, dsc, w);
f.DrawString(
(x * cellSize + cellSize DIV 2) - font.StringWidth(str) DIV 2,
(y * cellSize + cellSize DIV 2) + asc DIV 2, Ports.red, str, font);
INC(y)
END;
INC(x)
END
END Restore;
PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
VAR val, vis, w, h: INTEGER; changed: BOOLEAN;
BEGIN
WITH msg: Controllers.PollSectionMsg DO
v.context.GetSize(w, h);
msg.focus := FALSE; (* v is not a container *)
IF msg.vertical THEN
msg.partSize := h DIV cellSize;
msg.wholeSize := boardSize + MAX(0, msg.partSize +v.y - boardSize);
msg.partPos := v.y
ELSE
msg.partSize := w DIV cellSize;
msg.wholeSize := boardSize + MAX(0, msg.partSize + v.x - boardSize);
msg.partPos := v.x
END;
msg.valid := (msg.partSize < msg.wholeSize);
msg.done := TRUE
| msg: Controllers.ScrollMsg DO
v.context.GetSize(w, h); changed := FALSE;
msg.focus := FALSE; (* v is not a container *)
IF msg.vertical THEN
val := v.y; vis := h DIV cellSize
ELSE
val := v.x; vis := w DIV cellSize
END;
CASE msg.op OF
Controllers.decLine:
IF val > 0 THEN DEC(val); changed := TRUE END
| Controllers.incLine:
IF val < boardSize - vis THEN INC(val); changed := TRUE END
| Controllers.decPage:
DEC(val, vis); changed := TRUE;
IF val < 0THEN val := 0 END
| Controllers.incPage:
INC(val, vis); changed := TRUE;
IF val > boardSize - vis THEN val := boardSize - vis END
| Controllers.gotoPos:
val := msg.pos; changed := TRUE
END;
IF msg.vertical THEN v.y := val ELSE v.x := val END;
msg.done := TRUE;
IF changed THEN Views.Update(v, Views.keepFrames) END
| msg: Controllers.PageMsg DO
v.context.GetSize(w, h);
IF msg.op IN {Controllers.nextPageY, Controllers.gotoPageY} THEN
vis := h DIV cellSize
ELSE
vis := w DIV cellSize
END;
CASE msg.op OF
Controllers.nextPageX:
INC(v.x, vis)
| Controllers.nextPageY:
INC(v.y, vis)
| Controllers.gotoPageX:
v.x := msg.pageX * vis
| Controllers.gotoPageY:
v.y := msg.pageY * vis
END;
msg.done := TRUE;
msg.eox := v.x >= boardSize;
msg.eoy := v.y >= boardSize
ELSE
END
END HandleCtrlMsg;
PROCEDURE (v: View) HandlePropMsg (VAR p: Properties.Message);
BEGIN
WITH p: Properties.SizePref DO
IF p.w = Views.undefined THEN p.w := (boardSize - v.x) * cellSize END;
IF p.h = Views.undefined THEN p.h := (boardSize - v.y) * cellSize END
| p: Properties.ResizePref DO
p.horFitToWin := TRUE;
p.verFitToWin := TRUE
| p: Properties.FocusPref DO
p.setFocus := TRUE
ELSE (* ignore other messages *)
END
END HandlePropMsg;
PROCEDURE Deposit*;
VAR v: View;
BEGIN
NEW(v); v.x := 0; v.y := 0; Views.Deposit(v)
END Deposit;
PROCEDURE DepositAt* (x, y: INTEGER);
VAR v: View;
BEGIN
NEW(v); v.x := 0; v.y := 0;
IF (x > 0) & (x < boardSize) THEN v.x := x END;
IF (y > 0) & (y < boardSize) THEN v.y := y END;
Views.Deposit(v)
END DepositAt;
END ObxScroll.