blackbox-linux-console/BlackBox/Std/Mod/Logos.txt

MODULE StdLogos;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Logos.odc *)
	(* DO NOT EDIT *)

	IMPORT Ports, Stores, Views, Controllers, Properties;

	CONST
		W = 4;
		baseSize = 24 * Ports.point;

		colBase = 00202020H;

		changeColorKey = "#System:ChangeColor";

		minVersion = 0; maxVersion = 0;


	TYPE
		View = POINTER TO RECORD (Views.View)
			c: Ports.Color
		END;
		
		ChangeSizeOp = POINTER TO RECORD (Stores.Operation)
			view: View;
			size: INTEGER;
		END;
	
		ChangeColorOp = POINTER TO RECORD (Stores.Operation)
			view: View;
			color: Ports.Color
		END;
		
	(* curve painting *)

	PROCEDURE Paint (f: Views.Frame; size: INTEGER; col, bgnd: Ports.Color);
		VAR i, d, s, g, m, a, b, l, l0, rl, rt, rr, rb: INTEGER; c: Ports.Color;
	BEGIN
		s := size DIV 10; d := size DIV 2; g := d DIV 8; m := size * W DIV 2;
		f.DrawOval(0, s * 2, size * W, size, Ports.fill, col);
		f.DrawOval(s * W, s * 11 DIV 4, (size - s) * W, size - s * 3 DIV 4, Ports.fill, bgnd);
		a := m; b := m + d; c := 7 * colBase; i := 0;
		WHILE i < 4 DO
			f.DrawOval(a, 0, b, d, Ports.fill, c);
			INC(a, g); DEC(b, g); DEC(c, colBase); INC(i)
		END;
		f.rider.GetRect(rl, rt, rr, rb);
		l0 := rl; l := (f.gx + m + d DIV 2) DIV f.unit;
		IF l < rr THEN
			f.rider.SetRect(l, rt, rr, rb);
			a := m; b := m + d; c := 0; i := 0;
			WHILE i < 4 DO
				f.DrawOval(a, 0, b, d, Ports.fill, c);
				INC(a, g); DEC(b, g); INC(c, colBase); INC(i)
			END;
			f.rider.SetRect(l0, rt, rr, rb)
		END
	END Paint;

	(* ChangeOp *)

	PROCEDURE (op: ChangeSizeOp) Do;
		VAR v: View; size, w: INTEGER;
	BEGIN
		v := op.view;
		size := op.size; v.context.GetSize(w, op.size); v.context.SetSize(size * W, size);
		Views.Update(v, Views.keepFrames)
	END Do;

	PROCEDURE (op: ChangeColorOp) Do;
		VAR v: View; color: Ports.Color;
	BEGIN
		v := op.view;
		color := op.color; op.color := v.c; v.c := color;
		Views.Update(v, Views.keepFrames)
	END Do;

	(* View *)

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR thisVersion: INTEGER;
	BEGIN
		v.Internalize^(rd); IF rd.cancelled THEN RETURN END;
		rd.ReadVersion(minVersion, maxVersion, thisVersion); IF rd.cancelled THEN RETURN END;
		rd.ReadInt(v.c)
	END Internalize;

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		v.Externalize^(wr);
		wr.WriteVersion(maxVersion);
		wr.WriteInt(v.c)
	END Externalize;

	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		WITH source: View DO v.c := source.c END
	END CopyFromSimpleView;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR w, h: INTEGER; bgnd: Ports.Color; g: Views.Frame;
	BEGIN
		g := f;
		REPEAT
			g := Views.HostOf(g);
			bgnd := Views.transparent;
			g.view.GetBackground(bgnd)
		UNTIL bgnd # Views.transparent;
		v.context.GetSize(w, h);
		Paint(f, h, v.c, bgnd)
	END Restore;
	
	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																VAR focus: Views.View);
	BEGIN
		WITH msg: Properties.CollectMsg DO
			Views.HandlePropMsg(v, msg.poll)
		| msg: Properties.EmitMsg DO
			Views.HandlePropMsg(v, msg.set)
		ELSE	(* ignore other messages *)
		END
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
		VAR q: Properties.Property; p: Properties.StdProp;
			cop: ChangeColorOp;
	BEGIN
		WITH msg: Properties.SizePref DO
			IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
				(* constrain proposed size *)
				Properties.ProportionalConstraint(W, 1, msg.fixedW, msg.fixedH, msg.w, msg.h)
			ELSE
				(* return default size *)
				msg.w := W * baseSize; msg.h := baseSize
			END
		| msg: Properties.PollMsg DO
			NEW(p); p.known := {Properties.color}; p.valid := p.known;
			p.color.val := v.c;
			msg.prop := p
		| msg: Properties.SetMsg DO
			q := msg.prop;
			WHILE q # NIL DO
				WITH q: Properties.StdProp DO
					IF Properties.color IN q.valid THEN
						NEW(cop); cop.view := v; cop.color := q.color.val;
						Views.Do(v, changeColorKey, cop)
					END;
				ELSE
				END;
				q :=q.next
			END
		ELSE
		END
	END HandlePropMsg;
	
	PROCEDURE Deposit*;
		VAR v: View;
	BEGIN
		NEW(v); v.c := Ports.grey50; Views.Deposit(v)
	END Deposit;

END StdLogos.