Syntax10.Scn.Fnt
Syntax12.Scn.Fnt
ParcElems
Alloc
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
MODULE Viewers; (*JG 14.9.90*)
	Implement Viewers on top of Display, i.e. of the screen representing the whole display area.
Note: Display.FrameDesc defines the fields dsc, next and handle which are used by Viewers,but not by Display itself.
	IMPORT SYSTEM(*,O*),Display,Fonts;
	CONST
		restore* = 0; modify* = 1; suspend* = 2; (*message ids*)
		inf = MAX(INTEGER); (* "infinity" for frame and viewer sizes *)
	TYPE
The viewers of a track are kept in a sorted, circularly linked list. The list will always contain a filler viewer with Y=0 and H=Display.Height. The first element (as defined by where the dsc field of a track points to) is the filler viewer. The following viewer are sorted so that a viewer with a larger Y follows one with a smaller Y, i.e. they are sorted from bottom to top.
Sometimes there is a test, whther the next viewer has Y=0. This is used to test, whether it is the filler frame, as, by virtue of the sorting of the list and the fact, that viewers are always kept separate by at least minH one from another, no other frame except the first in the list may have an Y position of 0. Nevertheless it is very confusing for someone reading the code to see this test, instead of the more obvious test on state=filler.
On the other hand, if you look at the initialisation part of this module you see, that FillerViewer.state is never initialised!
		Viewer* = POINTER TO ViewerDesc;
		ViewerDesc* = RECORD (Display.FrameDesc)
			state*: INTEGER	(* state is read-only. No -, because Viewer was written before Oberon-2 *)
		END;
  	 (*state > 1: displayed
	  	  state = 1: filler	(* never used?? *)
	  	  state = 0: closed
	  	  state < 0: suspended*)
			The used fields are:
			restore: none.
			modify: Y,H and state.
			suspend: state.
		ViewerMsg* = RECORD (Display.FrameMsg)
			id*: INTEGER;
			X*, Y*, W*, H*: INTEGER;
			state*: INTEGER
		END;
		Track = POINTER TO TrackDesc;
		TrackDesc = RECORD (ViewerDesc)
			under: Display.Frame (* points to tracks covered by this track. *)
		END;
			curW is the width of the already configured part, and is initilaized to 0.
			minH is the minimum vertical distance of two viewers. This is used in Open.
			DW and DH duplicate Display.Width and Display.Height.
			FillerTrack is the track covering all unused display area.
			FillerViewer is the viewer covering all unused track area.
			buf stores the last closed viewer.
		curW*, minH*, DW, DH: INTEGER;
		FillerTrack: Track;
		FillerViewer: Viewer; 
		buf: Viewer;
	PROCEDURE Open*(V: Viewer; X, Y: INTEGER);
Opens a viewer if the state of the passed viewer is =closed and the X coordinate is not "infinity".
	    VAR T, u, v: Display.Frame; M: ViewerMsg;
    BEGIN
		IF (V.state = 0) & (X < inf) THEN
			(*
				Truncate Y to Display.Height.
			*)
			IF Y > DH THEN Y := DH END;
			(*
				Search the track containing X.
			*)
			T := FillerTrack.next;
			WHILE X >= T.X + T.W DO T := T.next END;
			(*
				Search the viewer in the track list, which is just below Y.
				v:=viewer containing Y.
				u:=viewer just below v.
			*)
			u := T.dsc; v := u.next;
			WHILE Y > v.Y + v.H DO u := v; v := u.next END;
			(*
				Adjust the requested Y, so that the new viewer is at least minH height.
			*)
			IF Y < v.Y + minH THEN Y := v.Y + minH END;
			(*
If the next viewer is not the filler viewer and the requested Y position is within the first minH pixel of the viewer then open the new viewer in place of the old one.
Otherwise reduce the viewer containing Y to terminate at position Y, where the new viewer is opened.
			*)
			IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
				WITH v: Viewer DO
					(*
						The new viewer is openend in place of the old one.
					*)
					V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H;
					(*
						The old viewer is sent a suspend message and unlinked.
						The new viewer becomes state=displayed.
					*)
					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
				(*
					The new viewer is opened within the old one, and covers the
					area between Y and the lower bound of the old one.
				*)
				V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y;
				(*
					The old viewer is reduced to cover only the area between its
					top boundary and Y, and receives a modify message.
				*)
				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;
				(*
					The new viewer is linked into the list and gets state=displayed.
				*)
				V.next := v; u.next := V;
				V.state := 2
			END
		END
    END Open;
	PROCEDURE Change*(V: Viewer; Y: INTEGER);
Reduce the viewer by moving the lower edge to the new Y value. This procedure cannot be used to increase the viewer, i.e. move the lower edge towards the bottom of the screen.
		v: Display.Frame; M: ViewerMsg;
	BEGIN
		IF V.state > 1 THEN
			(*
				truncate Y against Display.Height.
			*)
			IF Y > DH THEN Y := DH END;
			(*
				If the next next viewer is not the filler viewer then make sure, 
				that the new Y value is at least minH below the top edge fo the
				next window.
			*)
			v := V.next;
			IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
				Y := v.Y + v.H - minH
			END;
			(*
				Modify only, if the new position is at least minH above the current position.
			*)
			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);
		Remove track S and restore all tracks currently covered by S.
		T, t, v: Display.Frame; M: ViewerMsg;
	BEGIN
		WITH S: Track DO
			(*
				Search a (the?) track, preceeding one with the same X position as this one.
				Is this really a search for the predecessor of S? Then why not test for t.next=S?
			*)
			t := S.next;
			WHILE t.next.X # S.X DO t := t.next END;
			(*
Get the list of tracks covered by this one, and locate the last track in this list. This seems to indicate, that the list of covered tracks is no more a circular one.
			*)
			T := S.under;
			WHILE T.next # NIL DO T := T.next END;
			(*
All tracks in the S.under list are inserted between the track preceeding S and the track  following S. This operation removes S from the track list. 
			*)
			t.next := S.under; T.next := S.next;
			(*
A restore message is sent to all viewers of the newly uncovered tracks. Then the state of the viewer is chagend from suspended to displayed.
			*)
			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);
		Closes a viewer, if it has state=displayed.
		T, U: Display.Frame; M: ViewerMsg;
	BEGIN
		IF V.state > 1 THEN
			U := V.next;
			(*
				Search the track which contains this viewer.
			*)
			T := FillerTrack;
			REPEAT T := T.next UNTIL V.X < T.X + T.W;
			(*
If the viewer is not the only one in this track, or  the track does not cover any others, then only the viewer is closed. Thus the track will survive the closure of the last window on it, if it doesn't cover any other tracks.
			*)
			IF (T(Track).under = NIL) OR (U.next # V) THEN
				(*
Send a suspend message to the viewer to be closed, then set it's state to closed and assigned it to the last closed viewer buffer.
				*)
				M.id := suspend; M.state := 0;
				V.handle(V, M);
				V.state := 0; buf := V;
				(*
Send a modify message to the viewer above the closed one. Then adjust its Y and H fields.
				*)
				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;
				(*
Search the viewer preceeding the closed one, and unlink the closed one from the viewer list.
				*)
				WHILE U.next # V DO U := U.next END;
				U.next := V.next
			ELSE (*close track*)
				(*
Send a suspend message to the closed viewer and to the filler viewer of this track. Remeber the closed viewer in the buffer and use RestoreTrack to close the track and make all covered tracks visible.
				*)
				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);
		Returns the last closed viewer.
	BEGIN
		V := buf
	END Recall;
	PROCEDURE This*(X, Y: INTEGER): Viewer;
		Return the viewer which contains point X,Y.
		T, V: Display.Frame;
	BEGIN
		IF (X < inf) & (Y < DH) THEN
			(*
				Search the track, which contains the X component of the point. There is no test for
				the end of the list, because all area is covered either by a "real" track, or the filler track.
				Also, the search assumes, that the list is ordered, from left to right.
			*)
			T := FillerTrack;
			REPEAT T := T.next UNTIL X < T.X + T.W;
			(*
				Search the viewer containing the Y component of the point. There is no test for
				the end of the list, because all area is covered either by a "real" viewer, or the filler viewer.
				Also, the search assumes, that the list is ordered, from low to high.
			*)
			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;
		Return the next viewer in the track. I don't really know, why this procedure is there,
		as the next field is exported.
	BEGIN
		RETURN V.next(Viewer);
	END Next;
	PROCEDURE Locate*(X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
This procedure examines the viewers in the track containing X and returns this four viewers:
	fil: filler viewer of the track.
	bot: bottom viewer of this track.
	alt: The first viewer (from bottom) with a height of at least H.
	max: the viewer which has the greates height.
If the track doesn't contain any viewers, than bot, alt and max are equal to the filler viewer. If there is exactly one viewer, than alt will always return it.
If there are at least two viewers, alt will start the search with the second one. Thus it will never return the first (most bottom) viewer, even if it larger or equal to H. If none of the searched viewers is larger than H, then the largest one is returned.
		T, V: Display.Frame;
	BEGIN
		IF X < inf THEN
			(*
				Locate the track containing X.
			*)
			T := FillerTrack;
			REPEAT T := T.next UNTIL X < T.X + T.W;
			(*
				Get the filler and the bottom viewer.
			*)
			fil := T.dsc;
			bot := fil.next;
			(*
				If there is more than one viewer, then search (starting with the second viewer) for
				the first one with height>=H. If non found, return the one with the greates height.
				If there is less then two viewers, return the one found, or the filler viewer. 
			*)
			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;
			(*
				Set max to the viewer with the greatest height.
			*)
			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);
		Create a new track with specified width and height.
		S: Display.Frame;
		T: Track;
	BEGIN
		IF Filler.state = 0 THEN
			(*
				Prepare the filler viewer for the track, by setting the correct bounding box, state and performing
				the linking for the circular list.
			*)
			Filler.X := curW; Filler.W := W;
			Filler.Y := 0; Filler.H := H;
			Filler.state := 1; (* = filler *)
			Filler.next := Filler;
			(* Filler.dsc is not initialized. *)
			(*
				Create and initialize the new track.
			*)
			NEW(T);
			T.X := curW; T.W := W; T.Y := 0; T.H := H;
			T.dsc := Filler; T.under := NIL;
			(* FillerTrack.state is not initialized. *)
			(*
The filler track, and its filler viewer are reduced to occupy only the remaining room at the right of this track.
			*)
			FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X;
			FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W;
			(*
Search for the predecessor of the filler track, and add the new track to the track list. Adjust curW.
			*)
			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);
Open a new track at position X with width W over existing tracks. X and W are "proposals". X is adjusted to the left, so that it fully covers the track within which the original X lied. W is adjusted, so that the new track fully covers the track on which X+W lied.
		newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg;
	BEGIN
		IF (X < inf) & (Filler.state = 0) THEN
			(*
Search for the rightmost track (S) which is completely at the left of X and for the track (T) which contains the position X+W.
			*)
			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;
			(*
Send a suspend message to all viewers which are (partially) covered by the new track.
Note: It seems, that filler viewers may be suspended too.
			*)
			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;
			(*
				Prepare the list of viewers, as list containing only the filler viewer.
			*)
			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;
			(*
Create the new track. Link in the viewer list. Move the list of covered track under this track, and link in this track into the track list.
			*)
			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);
		Call the handler of each viewer in each track, and pass it the message M, and the viewer itself.
		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;
PROCEDURE TestHan(f: Display.Frame; VAR msg: Display.FrameMsg);
	InputMsg = RECORD (Display.FrameMsg)
		id: INTEGER;
		keys: SET;
		X, Y: INTEGER;
	END;
	InputMsgPtr=POINTER TO InputMsg;
	inp:InputMsgPtr;
BEGIN
	inp:=SYSTEM.VAL(InputMsgPtr,SYSTEM.ADR(msg));
	O.Str("TestHan:"); O.Int(inp.id); O.Int(inp.X); O.Int(inp.Y); O.Ln;
END TestHan;
BEGIN
	buf := NIL;
    DW := Display.Width; DH := Display.Height; (* copy for "easier" access. *)
    curW := 0; minH := Fonts.Default.height + 4;
	Create two circular linked lists, one containing the only viewer FillerViewer, and the other containing the
	only track FillerTrack.
	NOTE: The filler viewer has no handler !
    NEW(FillerViewer);
    FillerViewer.X := 0; FillerViewer.W := inf; FillerViewer.Y := 0; FillerViewer.H := DH;
    FillerViewer.next := FillerViewer; (* FillerViewer.dsc and FillerViewer.state are not initialized. *)
    FillerViewer.handle:=TestHan;
    NEW(FillerTrack);
    FillerTrack.X := 0; FillerTrack.W := inf; FillerTrack.Y := 0; FillerTrack.H := DH;
    FillerTrack.dsc := FillerViewer; (* A filler viewer is always present in every track. *)
    FillerTrack.next := FillerTrack; (* FillerTrack.under and FillerTrack.state are not initialized. *)
END Viewers.