Syntax10.Scn.Fnt
MODULE KeplerGraphs;	(* J. Templ, 30.10.90 *)
	IMPORT SYSTEM, KeplerPorts, Display, Files, Oberon, Modules, Types, Texts;
	CONST
		draw* = 0; restore* = 1;	(* notify op-codes *)
		ptSize = 12;
		maxNofpts = 4;
	(* graph = {star} {configuration} 0X.
		star = header contents.
		configuration = header contents.
		header = typeref [typename].
		typeref = compact-integer.
		typename = qualident 0X.
		contents = {byte}. *)
	TYPE
		Object* = POINTER TO ObjectDesc;
		ObjectDesc* = RECORD END ;
		Star* = POINTER TO StarDesc;
		StarDesc* = RECORD
			(ObjectDesc)
			x*, y*, refcnt*, ref: INTEGER;
			sel*: BOOLEAN;
			next* : Star;
		END ;
		Constellation* = POINTER TO ConsDesc;
		ConsDesc* = RECORD
			(ObjectDesc)
			nofpts*: INTEGER;
			p*: ARRAY maxNofpts OF Star;
			next*: Constellation;
		END ;
		Planet* = POINTER TO PlanetDesc;
		PlanetDesc* = RECORD
			(StarDesc)
			c*: Constellation;
		END;
		Graph* = POINTER TO GraphDesc;
		Notifier* = PROCEDURE (op: INTEGER; G: Graph; O: Object; P: KeplerPorts.Port);
		GraphDesc* = RECORD
			(ObjectDesc)
			cons*, lastcons: Constellation;
			stars*, laststar: Star;
			seltime*: LONGINT;
			notify*: Notifier;
		END ;
		StarTab = POINTER TO ARRAY OF LONGINT;
		loading*: Graph;
		update: KeplerPorts.BalloonPort;
		nofpt: INTEGER;
		starTab: StarTab;
		noftypes: LONGINT;
		typTab: ARRAY 256 OF LONGINT;
		del, delG: Graph;
	(* ---------------------------------- abstract methods ---------------------------------- *)
	PROCEDURE (self: Object) Draw* (P: KeplerPorts.Port);
	END Draw;
	PROCEDURE (self: Object) Read* (VAR R: Files.Rider);
	END Read;
	PROCEDURE (self: Object) Write* (VAR R: Files.Rider);
	END Write;
	(* ---------------------------------- auxiliary procedures ---------------------------------- *)
	PROCEDURE err(s0, s1: ARRAY OF CHAR);
		VAR W: Texts.Writer;
	BEGIN Texts.OpenWriter(W);
		Texts.WriteString(W, s0); Texts.WriteString(W, s1); Texts.WriteLn(W);
		Texts.Append(Oberon.Log, W.buf)
	END err;
	PROCEDURE err2(s0, s1: ARRAY OF CHAR);
		VAR W: Texts.Writer;
	BEGIN Texts.OpenWriter(W);
		Texts.WriteString(W, s0); Texts.WriteString(W, s1);
		Texts.Append(Oberon.Log, W.buf)
	END err2;
	PROCEDURE ReadObj* (VAR R: Files.Rider; VAR x: Object);
		VAR ref: LONGINT;
			m: Modules.Module; t: Types.Type;
			module, type: ARRAY 32 OF CHAR;
	BEGIN x := NIL;
		Files.ReadNum(R, ref);
		IF ref = noftypes THEN
			Files.ReadString(R, module);
			Files.ReadString(R, type);
			m := Modules.ThisMod(module);
			IF m # NIL THEN t := Types.This(m, type);
				IF t # NIL THEN typTab[ref] := SYSTEM.VAL(LONGINT, t); INC(noftypes);
					Types.NewObj(x, t); x.Read(R)
				ELSE err("-- type not found: ", type)
				END
			ELSE err2("-- error: ", Modules.importing);
				IF Modules.res = 2 THEN err(" not an obj-file", "")
				ELSIF Modules.res = 3 THEN err2(" imports ", Modules.imported); err(" with bad key", "");
				ELSIF Modules.res = 4 THEN err(" corrupted obj file", "")
				ELSIF Modules.res = 7 THEN err(" not enough space", "")
				END;
				(*Modules.res := 0*)
			END
		ELSIF ref # -1 THEN
			Types.NewObj(x, SYSTEM.VAL(Types.Type, typTab[ref]));
			x.Read(R)
		END
	END ReadObj;
	PROCEDURE WriteObj* (VAR R: Files.Rider; x: Object);
		VAR typ: Types.Type; i: LONGINT;
	BEGIN
		IF x # NIL THEN
			typ := Types.TypeOf(x); i := 0;
			WHILE (i < noftypes) & (SYSTEM.VAL(LONGINT, typ) # typTab[i]) DO INC(i) END ;
			IF i = noftypes THEN
				Files.WriteNum(R, i);
				typTab[i] := SYSTEM.VAL(LONGINT, typ); INC(noftypes);
				Files.WriteString(R, typ.module.name);
				Files.WriteString(R, typ.name)
			ELSE
				Files.WriteNum(R, i)
			END ;
			x.Write(R)
		ELSE Files.WriteNum(R, -1)
		END
	END WriteObj;
	PROCEDURE GetType* (o: Object; VAR module, type: ARRAY OF CHAR);
		VAR t: Types.Type;
	BEGIN t := Types.TypeOf(o); COPY(t.module.name, module); COPY(t.name, type)
	END GetType;
	PROCEDURE Reset*;
	BEGIN nofpt := 0; noftypes := 0
	END Reset;
	PROCEDURE GetStar (n: INTEGER): Star;
		VAR s: Star;
	BEGIN s := SYSTEM.VAL(Star, starTab[n]); INC(s.refcnt); RETURN s
	END GetStar;
	(* ---------------------------------- Star methods ---------------------------------- *)
	PROCEDURE (self: Star) Draw* (P: KeplerPorts.Port);
	BEGIN
		IF self.sel THEN
			P.FillRect(self.x - ptSize, self.y - ptSize, ptSize*2 + P.scale, ptSize*2 + P.scale, Display.white, 5, Display.invert)
		END
	END Draw;
	PROCEDURE (self: Star) Read* (VAR R: Files.Rider);
		VAR h: LONGINT;
	BEGIN self.sel := FALSE;
		Files.ReadNum(R, h); self.x := SHORT(h);
		Files.ReadNum(R, h); self.y := SHORT(h)
	END Read;
	PROCEDURE (self: Star) Write* (VAR R: Files.Rider);
	BEGIN
		Files.WriteNum(R, self.x);
		Files.WriteNum(R, self.y)
	END Write;
	(* ---------------------------------- Constellation methods ---------------------------------- *)
	PROCEDURE (self: Constellation) State* (): INTEGER;	(* unselected = 0; partially selected = 1; totally selected = 2 *)
		VAR sum, i: INTEGER;
	BEGIN sum := 0; i := 0;
		WHILE i < self.nofpts DO
			IF self.p[i].sel THEN INC(sum) END ;
			INC(i)
		END ;
		IF sum = 0 THEN RETURN 0
		ELSIF sum = self.nofpts THEN RETURN 2
		ELSE RETURN 1
		END
	END State;
	PROCEDURE (self: Constellation) Read* (VAR R: Files.Rider);
		VAR ref, i: LONGINT;
	BEGIN i := 0;
		Files.ReadNum(R, ref); self.nofpts := SHORT(ref);
		i := 0;
		WHILE i < self.nofpts DO
			Files.ReadNum(R, ref);
			self.p[i] := GetStar(SHORT(ref));
			INC(i)
		END
	END Read;
	PROCEDURE (self: Constellation) Write* ( VAR R: Files.Rider);
		VAR i: INTEGER;
	BEGIN i := 0;
		Files.WriteNum(R, self.nofpts);
		WHILE i < self.nofpts DO Files.WriteNum(R, self.p[i].ref); INC(i) END
	END Write;
	(* ---------------------------------- Planet methods ---------------------------------- *)
	PROCEDURE (self: Planet) Draw* (P: KeplerPorts.Port);
	BEGIN
		IF self.sel THEN
			P.DrawRect(self.x - ptSize, self.y - ptSize, ptSize*2, ptSize*2, Display.white, Display.invert)
		END
	END Draw;
	PROCEDURE (self: Planet) Calc*;
	END Calc;
	PROCEDURE (self: Planet) Read* (VAR R: Files.Rider);
		VAR o: Object;
	BEGIN self.Read^(R); ReadObj(R, o); self.c := o(Constellation)
	END Read;
	PROCEDURE (self: Planet) Write* (VAR R: Files.Rider);
	BEGIN self.Write^(R); WriteObj(R, self.c)
	END Write;
	(* ---------------------------------- Graphic methods ---------------------------------- *)
	PROCEDURE (G: Graph) Append*(o: Object);
	BEGIN
		IF o IS Star THEN
			WITH o: Star DO
				IF G.stars = NIL THEN G.stars := o ELSE G.laststar.next := o END ;
				G.laststar := o; o.next := NIL
			END
		ELSE
			WITH o: Constellation DO
				IF G.cons = NIL THEN G.cons := o ELSE G.lastcons.next := o END ;
				G.lastcons := o; o.next := NIL;
				G.notify(draw, G, o, NIL)
			END
		END
	END Append;
	PROCEDURE (G: Graph) FlipSelection*(p: Star);
	BEGIN
		IF p.sel THEN G.notify(draw, G, p, NIL); p.sel := FALSE
		ELSE p.sel := TRUE; G.notify(draw, G, p, NIL); G.seltime := Oberon.Time()
		END
	END FlipSelection;
	PROCEDURE DependsOn(c: Constellation; s: Star): BOOLEAN;
		VAR i: INTEGER; p: Star;
	BEGIN i := 0;
		WHILE i < c.nofpts DO p := c.p[i];
			IF p = s THEN RETURN TRUE
			ELSIF (p IS Planet) & DependsOn(p(Planet).c, s) THEN RETURN TRUE
			END ;
			INC(i)
		END ;
		RETURN FALSE
	END DependsOn;
	PROCEDURE (G: Graph) Move*(s: Star; dx, dy: INTEGER);
		VAR p: Star; c: Constellation;
	BEGIN
		KeplerPorts.InitBalloon(update);
		c := G.cons;
		WHILE c # NIL DO
			IF DependsOn(c, s) THEN c.Draw(update) END ;
			c := c.next
		END ;
		p := s^.next;
		WHILE p # NIL DO
			IF (p IS Planet) & DependsOn(p(Planet).c, s) THEN p.Draw(update) END ;
			p := p.next
		END ;
		s.Draw(update); INC(s.x, dx); INC(s.y, dy); s.Draw(update);
		p := s^.next;
		WHILE p # NIL DO
			IF (p IS Planet) & DependsOn(p(Planet).c, s) THEN p(Planet).Calc; p.Draw(update) END ;
			p := p.next
		END ;
		c := G.cons;
		WHILE c # NIL DO
			IF DependsOn(c, s) THEN c.Draw(update) END ;
			c := c.next
		END ;
		G.notify(restore, G, NIL, update)
	END Move;
	PROCEDURE (G: Graph) MoveSelection*(dx, dy: INTEGER);
		VAR p: Star; c: Constellation;
	BEGIN
		KeplerPorts.InitBalloon(update);
		p := G.stars;
		WHILE p # NIL DO  (*expand selection*)
			IF ~p.sel & (p IS Planet) & (p(Planet).c.State() > 0) THEN p.sel := TRUE END ;
			p := p.next
		END ;
		c := G.cons;
		WHILE c # NIL DO
			IF c.State() # 0 THEN c.Draw(update) END ;
			c := c.next
		END ;
		p := G.stars;
		WHILE p # NIL DO
			IF p.sel THEN
				p.Draw(update);
				IF p IS Planet THEN p(Planet).Calc
				ELSE INC(p.x, dx); INC(p.y, dy)
				END ;
				p.Draw(update)
			END ;
			p := p.next
		END ;
		c := G.cons;
		WHILE c # NIL DO
			IF c.State() # 0 THEN c.Draw(update) END ;
			c := c.next
		END ;
		G.notify(restore, G, NIL, update)
	END MoveSelection;
	PROCEDURE ReverseStars(G: Graph);
		VAR p, first, next: Star;
	BEGIN p := G.stars;
		G.laststar := p; first := NIL;
		WHILE p # NIL DO
			next := p.next; p.next := first;
			first := p; p := next
		END ;
		G.stars := first
	END ReverseStars;
	PROCEDURE Release (self: Constellation);
		VAR i: INTEGER; s: Star;
	BEGIN i := 0;
		WHILE i < self.nofpts DO s := self.p[i]; DEC(s.refcnt); INC(i) END
	END Release;
	PROCEDURE CutCons (G: Graph; prevc, c: Constellation);
	BEGIN
		IF prevc = NIL THEN G.cons := c.next ELSE prevc.next := c.next END ;
		IF del.cons = NIL THEN del.cons := c ELSE del.lastcons.next := c END ;
		del.lastcons := c;
		IF G.lastcons = c THEN G.lastcons:= prevc END ;
		Release(c); c.Draw(update)
	END CutCons;
	PROCEDURE CutStar (G:Graph; prevs, s: Star);
	BEGIN
		IF prevs = NIL THEN G.stars := s.next ELSE prevs.next := s.next END ;
		IF del.stars = NIL THEN del.stars := s ELSE del.laststar.next := s END ;
		del.laststar := s;
		IF G.laststar = s THEN G.laststar := prevs END ;
		IF s IS Planet THEN Release(s(Planet).c) END ;
		s.ref := 0;
		s.Draw(update)
	END CutStar;
	PROCEDURE DelStar(G: Graph; o: Object);
		VAR s, prevs: Star;
	BEGIN
		s := G.stars; prevs := NIL;
		WHILE (s # NIL) & (s # o) DO prevs := s; s := s.next END ;
		IF s # NIL THEN CutStar(G, prevs, s) END
	END DelStar;
	PROCEDURE (G: Graph) Delete* (o: Object);
		VAR c, prevc: Constellation; i: INTEGER;
	BEGIN
		KeplerPorts.InitBalloon(update);
		delG := G; del.cons := NIL; del.stars := NIL;
		IF o IS Constellation THEN
			c := G.cons; prevc := NIL;
			WHILE (c # NIL) & (c # o) DO prevc := c; c := c.next END ;
			IF c # NIL THEN
				CutCons(G, prevc, c); i := 0;
				WHILE i < c.nofpts DO
					IF (c.p[i].refcnt = 0) & ~(c.p[i] IS Planet) THEN DelStar(G, c.p[i]) END ;
					INC(i)
				END
			END
		ELSE ASSERT(o(Star).refcnt = 0);
			IF o IS Planet THEN
				c := o(Planet).c; Release(c); i := 0;
				WHILE i < c.nofpts DO
					IF (c.p[i].refcnt = 0) & ~(c.p[i] IS Planet) THEN DelStar(G, c.p[i]) END ;
					INC(i)
				END
			END ;
			DelStar(G, o)
		END ;
		IF del.cons # NIL THEN del.lastcons.next := NIL END ;
		IF del.stars # NIL THEN del.laststar.next := NIL END ;
		G.notify(restore, G, NIL, update)
	END Delete;
	PROCEDURE (G: Graph) DeleteSelection* (minstate: INTEGER);
		VAR s, prevs: Star; c, prevc: Constellation;
	BEGIN
		delG := G; KeplerPorts.InitBalloon(update);
	(*move all constellations with (State >= minstate) into del buffer*)
		c := G.cons; prevc := NIL; del.cons := NIL;
		WHILE c # NIL DO
			IF c.State() >= minstate THEN CutCons(G, prevc, c) ELSE prevc := c END ;
			c := c.next
		END ;
		IF del.cons # NIL THEN del.lastcons.next := NIL END ;
	(*move all unused stars and planets with refcnt=0 & c.State>=minstate into del buffer*)
		ReverseStars(G);
		s := G.stars; prevs := NIL; del.stars := NIL;
		WHILE s # NIL DO
			IF (s.refcnt = 0) & (~(s IS Planet) OR s.sel OR (s(Planet).c.State() >= minstate)) THEN CutStar(G, prevs, s)
			ELSE prevs := s
			END ;
			s := s.next
		END ;
		ReverseStars(G) ;
		IF del.stars # NIL THEN del.laststar.next := NIL; ReverseStars(del) END ;
		G.notify(restore, G, NIL, update)
	END DeleteSelection;
	PROCEDURE (G: Graph) All* (op: INTEGER);	(* deselect = 0; select = 1 *)
		VAR p: Star;
	BEGIN p := G.stars;
		KeplerPorts.InitBalloon(update);
		WHILE p # NIL DO
			IF (op = 1) # p.sel THEN
				IF p.sel THEN p.Draw(update); p.sel := FALSE
				ELSE p.sel := TRUE; p.Draw(update); G.seltime := Oberon.Time()
				END
			END ;
			p := p.next
		END ;
		IF op = 0 THEN G.seltime := -1 END ;
		G.notify(restore, G, NIL, update)
	END All;
	PROCEDURE Store(G: Graph; VAR R: Files.Rider; all: BOOLEAN);
		VAR p, dummy: Star; c: Constellation;
	BEGIN
		p := G.stars;
		NEW(dummy);
		WHILE p # NIL DO
			IF all OR (p.sel & ~(p IS Planet)) THEN
				WriteObj(R, p); p.ref := nofpt; INC(nofpt)
			ELSIF p.sel & (p(Planet).c.State() = 2) THEN
				WriteObj(R, p); p.ref := nofpt; INC(nofpt)
			ELSIF p.sel & (p(Planet).c.State() # 2) THEN
				dummy^ := p^; WriteObj(R, dummy); p.ref := nofpt; INC(nofpt)
			END ;
			p := p.next
		END ;
		c := G.cons;
		WHILE c # NIL DO
			IF all OR (c.State()=2) THEN WriteObj(R, c) END ;
			c := c.next
		END ;
		Files.WriteNum(R, -1)
	END Store;
	PROCEDURE (G: Graph) Draw* (P: KeplerPorts.Port);
		VAR s: Star; c: Constellation;
	BEGIN
		c := G.cons;
		WHILE c # NIL DO c.Draw(P); c := c.next END ;
		s := G.stars;
		WHILE s # NIL DO s.Draw(P); s := s.next END
	END Draw;
	PROCEDURE (G: Graph) Write* (VAR R: Files.Rider);
	BEGIN
		Store(G, R, TRUE)
	END Write;
	PROCEDURE (G: Graph) WriteSel* (VAR R: Files.Rider);
	BEGIN Store(G, R, FALSE)
	END WriteSel;
	PROCEDURE DoubleStarTab;
		VAR h: StarTab; i: LONGINT;
	BEGIN i := 0; NEW(h, LEN(starTab^)*2);
		WHILE i < LEN(starTab^) DO h[i] := starTab[i]; INC(i) END ;
		starTab := h
	END DoubleStarTab;
	PROCEDURE (G: Graph) Read* (VAR R: Files.Rider);
		VAR o, o0: Object;
	BEGIN loading := G;
		G.stars := NIL; G.laststar := NIL; G.cons := NIL; G.lastcons := NIL; G.seltime := -1;
		ReadObj(R, o0); o := o0;
		WHILE o # NIL DO	(* append without notification *)
			WITH o: Star DO
				IF G.stars = NIL THEN G.stars := o ELSE G.laststar.next := o END ;
				G.laststar := o; o.next := NIL;
				IF nofpt = LEN(starTab^) THEN DoubleStarTab END ;
				starTab[nofpt] := SYSTEM.VAL(LONGINT, o); INC(nofpt)
			| o: Constellation DO 
				IF G.cons = NIL THEN G.cons := o ELSE G.lastcons.next := o END ;
				G.lastcons := o; o.next := NIL
			END ;
			ReadObj(R, o)
		END
	END Read;
	PROCEDURE Old*(name: ARRAY OF CHAR): Graph;
		VAR F: Files.File; R: Files.Rider; o: Object;
	BEGIN F := Files.Old(name);
		IF F # NIL THEN Files.Set(R, F, 0); Reset; ReadObj(R, o);
			IF R.res = 0 THEN RETURN o(Graph) ELSE RETURN NIL END
		ELSE RETURN NIL
		END
	END Old;
	PROCEDURE *Dummy(op: INTEGER; g: Graph; c: Object; f: KeplerPorts.Port);
	END Dummy;
	PROCEDURE (G: Graph) CopySelection* (from: Graph; dx, dy: INTEGER);
		VAR cpBuf: Files.File;
			R: Files.Rider;
			c, nextc: Constellation;
			p, nextp: Star;
			buf: Graph;
	BEGIN
		cpBuf := Files.New("");
		Files.Set(R, cpBuf, 0);
		Reset; from.WriteSel(R);
		Files.Set(R, cpBuf, 0); Types.NewObj(buf, Types.TypeOf(from)); buf.notify := Dummy;
		Reset; buf.Read(R);
		p := buf.stars;
		WHILE p # NIL DO nextp := p.next;
			INC(p.x, dx); INC(p.y, dy);
			IF (p.refcnt > 0) OR (p IS Planet) THEN G.Append(p) END;
			p := nextp
		END ;
		c := buf.cons; KeplerPorts.InitBalloon(update);
		WHILE c # NIL DO c.Draw(update); nextc := c.next;
			IF G.cons = NIL THEN G.cons := c ELSE G.lastcons.next := c END ;
			G.lastcons := c; c.next := NIL;
			c := nextc
		END ;
		G.notify(restore, G, NIL, update)
	END CopySelection;
	PROCEDURE (G: Graph) SendToBack* (o: Object);
		VAR i: INTEGER;
			s: Star;
			c: Constellation;
	BEGIN
		WITH
			o: Star DO
				s := G.stars;
				IF o # s THEN
					WHILE s.next # o DO s := s.next END ;
					s.next := o.next; o.next := G.stars; G.stars := o;
					IF G.laststar = o THEN G.laststar := s END ;
					IF o IS Planet THEN	(* preserve topological order *)
						c := o(Planet).c;
						FOR i := 0 TO c.nofpts-1 DO
							G.SendToBack(c.p[i])
						END
					END
				END
		| o: Constellation DO
				KeplerPorts.InitBalloon(update);
				c := G.cons;
				IF o # c THEN
					WHILE c.next # o DO c := c.next END ;
					c.next := o.next; o.next := G.cons; G.cons := o;
					IF G.lastcons = o THEN G.lastcons := c END ;
					o.Draw(update);
					G.notify(restore, G, NIL, update)
				END
		END
	END SendToBack;
	PROCEDURE Unrelease(c: Constellation);
		VAR i: INTEGER;
	BEGIN i := 0;
		WHILE i < c.nofpts DO INC(c.p[i].refcnt); INC(i) END
	END Unrelease;
	PROCEDURE Recall*;
		VAR s, nexts: Star; c, nextc: Constellation;
	BEGIN
		IF delG # NIL THEN
			s := del.stars;
			WHILE s # NIL DO
				nexts := s.next; s.sel := FALSE; delG.Append(s);
				IF s IS Planet THEN Unrelease(s(Planet).c) END ;
				s := nexts
			END ;
			c := del.cons;
			WHILE c # NIL DO nextc := c.next; delG.Append(c); Unrelease(c); c := nextc END ;
			delG := NIL; del.cons := NIL; del.lastcons := NIL; del.stars := NIL; del.laststar := NIL
		END
	END Recall;
BEGIN NEW(update); NEW(del); NEW(starTab, 1)
END KeplerGraphs.