Oberon/V2/Viewers
< Oberon
MODULE Viewers; (*JG 14.9.90*)
IMPORT Display;
CONST
restore* = 0; modify* = 1; suspend* = 2; (*message id*)
inf = MAX(INTEGER);
TYPE
Viewer* = POINTER TO ViewerDesc;
ViewerDesc* = RECORD (Display.FrameDesc)
state*: INTEGER
END;
(*state > 1: displayed
state = 1: filler
state = 0: closed
state < 0: suspended*)
ViewerMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
X*, Y*, W*, H*: INTEGER;
state*: INTEGER
END;
Track = POINTER TO TrackDesc;
TrackDesc = RECORD (ViewerDesc)
under: Display.Frame
END;
VAR
curW*, minH*, DW, DH: INTEGER;
FillerTrack: Track; FillerViewer, buf: Viewer; (*for closed viewers*)
PROCEDURE Open* (V: Viewer; X, Y: INTEGER);
VAR T, u, v: Display.Frame; M: ViewerMsg;
BEGIN
IF (V.state = 0) & (X < inf) THEN
IF Y > DH THEN Y := DH END;
T := FillerTrack.next;
WHILE X >= T.X + T.W DO T := T.next END;
u := T.dsc; v := u.next;
WHILE Y > v.Y + v.H DO u := v; v := u.next END;
IF Y < v.Y + minH THEN Y := v.Y + minH END;
IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
WITH v: Viewer DO
V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H;
M.id := suspend; M.state := 0;
v.handle(v, M); v.state := 0; buf := v;
V.next := v.next; u.next := V;
V.state := 2
END
ELSE
V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y;
M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
v.handle(v, M); v.Y := M.Y; v.H := M.H;
V.next := v; u.next := V;
V.state := 2
END
END
END Open;
PROCEDURE Change* (V: Viewer; Y: INTEGER);
VAR v: Display.Frame; M: ViewerMsg;
BEGIN
IF V.state > 1 THEN
IF Y > DH THEN Y := DH END;
v := V.next;
IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
Y := v.Y + v.H - minH
END;
IF Y >= V.Y + minH THEN
M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
v.handle(v, M); v.Y := M.Y; v.H := M.H;
V.H := Y - V.Y
END
END
END Change;
PROCEDURE RestoreTrack (S: Display.Frame);
VAR T, t, v: Display.Frame; M: ViewerMsg;
BEGIN
WITH S: Track DO
t := S.next;
WHILE t.next.X # S.X DO t := t.next END;
T := S.under;
WHILE T.next # NIL DO T := T.next END;
t.next := S.under; T.next := S.next;
M.id := restore;
REPEAT t := t.next;
v := t.dsc;
REPEAT v := v.next; v.handle(v, M);
WITH v: Viewer DO v.state := - v.state END
UNTIL v = t.dsc
UNTIL t = T
END
END RestoreTrack;
PROCEDURE Close* (V: Viewer);
VAR T, U: Display.Frame; M: ViewerMsg;
BEGIN
IF V.state > 1 THEN
U := V.next; T := FillerTrack;
REPEAT T := T.next UNTIL V.X < T.X + T.W;
IF (T(Track).under = NIL) OR (U.next # V) THEN
M.id := suspend; M.state := 0;
V.handle(V, M); V.state := 0; buf := V;
M.id := modify; M.Y := V.Y; M.H := V.H + U.H;
U.handle(U, M); U.Y := M.Y; U.H := M.H;
WHILE U.next # V DO U := U.next END;
U.next := V.next
ELSE (*close track*)
M.id := suspend; M.state := 0;
V.handle(V, M); V.state := 0; buf := V;
U.handle(U, M); U(Viewer).state := 0;
RestoreTrack(T)
END
END
END Close;
PROCEDURE Recall* ( VAR V: Viewer);
BEGIN V := buf
END Recall;
PROCEDURE This* (X, Y: INTEGER): Viewer;
VAR T, V: Display.Frame;
BEGIN
IF (X < inf) & (Y < DH) THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
V := T.dsc;
REPEAT V := V.next UNTIL Y < V.Y + V.H;
RETURN V(Viewer)
ELSE RETURN NIL
END
END This;
PROCEDURE Next* (V: Viewer): Viewer;
BEGIN RETURN V.next(Viewer)
END Next;
PROCEDURE Locate* (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
VAR T, V: Display.Frame;
BEGIN
IF X < inf THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
fil := T.dsc; bot := fil.next;
IF bot.next # fil THEN
alt := bot.next; V := alt.next;
WHILE (V # fil) & (alt.H < H) DO
IF V.H > alt.H THEN alt := V END; V := V.next
END
ELSE alt := bot
END;
max := T.dsc; V := max.next;
WHILE V # fil DO
IF V.H > max.H THEN max := V END; V := V.next
END
END
END Locate;
PROCEDURE InitTrack* (W, H: INTEGER; Filler: Viewer);
VAR S: Display.Frame; T: Track;
BEGIN
IF Filler.state = 0 THEN
Filler.X := curW; Filler.W := W; Filler.Y := 0; Filler.H := H;
Filler.state := 1;
Filler.next := Filler;
NEW(T);
T.X := curW; T.W := W; T.Y := 0; T.H := H;
T.dsc := Filler; T.under := NIL;
FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X;
FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W;
S := FillerTrack;
WHILE S.next # FillerTrack DO S := S.next END;
S.next := T; T.next := FillerTrack;
curW := curW + W
END
END InitTrack;
PROCEDURE OpenTrack* (X, W: INTEGER; Filler: Viewer);
VAR newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg;
BEGIN
IF (X < inf) & (Filler.state = 0) THEN
S := FillerTrack; T := S.next;
WHILE X >= T.X + T.W DO S := T; T := S.next END;
WHILE X + W > T.X + T.W DO T := T.next END;
M.id := suspend;
t := S;
REPEAT t := t.next; v := t.dsc;
REPEAT v := v.next;
WITH v: Viewer DO
M.state := -v.state; v.handle(v, M); v.state := M.state
END
UNTIL v = t.dsc
UNTIL t = T;
Filler.X := S.next.X; Filler.W := T.X + T.W - S.next.X; Filler.Y := 0; Filler.H := DH;
Filler.state := 1;
Filler.next := Filler;
NEW(newT);
newT.X := Filler.X; newT.W := Filler.W; newT.Y := 0; newT.H := DH;
newT.dsc := Filler; newT.under := S.next; S.next := newT;
newT.next := T.next; T.next := NIL
END
END OpenTrack;
PROCEDURE CloseTrack* (X: INTEGER);
VAR T, V: Display.Frame; M: ViewerMsg;
BEGIN
IF X < inf THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
IF T(Track).under # NIL THEN
M.id := suspend; M.state := 0; V := T.dsc;
REPEAT V := V.next; V.handle(V, M); V(Viewer).state := 0 UNTIL V = T.dsc;
RestoreTrack(T)
END
END
END CloseTrack;
PROCEDURE Broadcast* (VAR M: Display.FrameMsg);
VAR T, V: Display.Frame;
BEGIN
T := FillerTrack.next;
WHILE T # FillerTrack DO
V := T.dsc;
REPEAT V := V.next; V.handle(V, M) UNTIL V = T.dsc;
T := T.next
END
END Broadcast;
BEGIN buf := NIL;
NEW(FillerViewer);
FillerViewer.X := 0; FillerViewer.W := inf; FillerViewer.Y := 0; FillerViewer.H := DH;
FillerViewer.next := FillerViewer;
NEW(FillerTrack);
FillerTrack.X := 0; FillerTrack.W := inf; FillerTrack.Y := 0; FillerTrack.H := DH;
FillerTrack.dsc := FillerViewer;
FillerTrack.next := FillerTrack;
curW := 0; minH := 1;
DW := Display.Width; DH := Display.Height
END Viewers.