Oberon/V2/Viewers

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.