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

MODULE StdHeaders;

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

(* headers / footers support the following macros:

			&p - replaced by current page number as arabic numeral
			&r - replaced by current page number as roman numeral
			&R - replaced by current page number as capital roman numeral
			&a - replaced by current page number as alphanumeric character
			&A - replaced by current page number as capital alphanumeric character
			&d - replaced by printing date 
			&t - replaced by printing time
			&&- replaced by & character
			&; - specifies split point
			&f - filename with path/title

*)

	IMPORT
		Stores, Ports, Models, Views, Properties, Printing, TextModels, Fonts, Dialog,
		TextViews, Dates, Windows, Controllers, Containers;

	CONST
		minVersion = 0; maxVersion = 2;
		mm = Ports.mm; point = Ports.point;
		maxWidth = 10000 * mm;
		alternate* = 0; number* = 1; head* = 2; foot* = 3; showFoot* = 4;

	TYPE
		Banner* = RECORD
			left*, right*: ARRAY 128 OF CHAR;
			gap*: INTEGER
		END;
		
		NumberInfo* = RECORD
			new*: BOOLEAN;
			first*: INTEGER
		END;
		
		View = POINTER TO RECORD (Views.View)
			alternate: BOOLEAN;	(* alternate left/right *)
			number: NumberInfo;	(* new page number *)
			head, foot: Banner;
			font: Fonts.Font;
			showFoot: BOOLEAN;
		END;

		Prop* = POINTER TO RECORD (Properties.Property)
			alternate*, showFoot*: BOOLEAN;
			number*: NumberInfo;
			head*, foot*: Banner
		END;

		ChangeFontOp = POINTER TO RECORD (Stores.Operation)
			header: View;
			font: Fonts.Font
		END;

		ChangeAttrOp = POINTER TO RECORD (Stores.Operation)
			header: View;
			alternate, showFoot: BOOLEAN;
			number: NumberInfo;
			head, foot: Banner
		END;

	VAR
		dialog*: RECORD
			view: View;
			alternate*, showFoot*: BOOLEAN;
			number*: NumberInfo;
			head*, foot*: Banner;
		END;
		
	PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
		VAR valid: SET;
		PROCEDURE Equal(IN b1, b2: Banner): BOOLEAN;
		BEGIN
			RETURN (b1.left = b2.left) & (b1.right = b2.right) & (b1.gap = b2.gap)
		END Equal;
	BEGIN
		WITH q: Prop DO
			valid := p.valid * q.valid; equal := TRUE;
			IF p.alternate # q.alternate THEN EXCL(valid, alternate) END;
			IF p.showFoot # q.showFoot THEN EXCL(valid, showFoot) END;
			IF (p.number.new # q.number.new) OR (p.number.first # q.number.first) THEN EXCL(valid, number) END;
			IF ~Equal(p.head, q.head) THEN EXCL(valid, head) END;
			IF ~Equal(p.foot, q.foot) THEN EXCL(valid, foot) END;
			IF p.valid # valid THEN p.valid := valid; equal := FALSE END
		END
	END IntersectWith;
		
	(* SetAttrOp *)

	PROCEDURE (op: ChangeFontOp) Do;
		VAR v: View; font: Fonts.Font; asc, dsc, w: INTEGER; c: Models.Context;
	BEGIN
		v := op.header;
		font := op.font; op.font := v.font; v.font := font;
		font.GetBounds(asc, dsc, w);
		c := v.context;
		c.SetSize(maxWidth, asc + dsc + 2*point);
		Views.Update(v, Views.keepFrames)
	END Do;

	PROCEDURE DoChangeFontOp (v: View; font: Fonts.Font);
		VAR op: ChangeFontOp;
	BEGIN
		IF v.font # font THEN
			NEW(op); op.header := v; op.font := font;
			Views.Do(v,   "#System:SetProp", op)
		END
	END DoChangeFontOp;

	PROCEDURE (op: ChangeAttrOp) Do;
		VAR v: View; alternate, showFoot: BOOLEAN; number: NumberInfo; head, foot: Banner;
	BEGIN
		v := op.header;
		alternate := op.alternate; showFoot := op.showFoot; number := op.number; head := op.head; foot := op.foot;
		op.alternate := v.alternate; op.showFoot := v.showFoot; op.number := v.number; op.head := v.head;
		op.foot := v.foot;
		v.alternate := alternate; v.showFoot := showFoot; v.number := number; v.head := head; v.foot := foot;
		Views.Update(v, Views.keepFrames)
	END Do;

	PROCEDURE DoChangeAttrOp (v: View; alternate, showFoot: BOOLEAN; number: NumberInfo;
													head, foot: Banner);
		VAR op: ChangeAttrOp;
	BEGIN
		NEW(op); op.header := v; op.alternate := alternate; op.showFoot := showFoot; 
		op.number := number; op.head := head; op.foot := foot;
		Views.Do(v,   "#Std:HeaderChange", op)
	END DoChangeAttrOp;

	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		WITH source: View DO
			v.alternate := source.alternate;
			v.number.new := source.number.new; v.number.first := source.number.first;
			v.head := source.head;
			v.foot := source.foot;
			v.font := source.font;
			v.showFoot := source.showFoot
		END
	END CopyFromSimpleView;

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		v.Externalize^(wr);
		wr.WriteVersion(maxVersion);
		wr.WriteString(v.head.left);
		wr.WriteString(v.head.right);
		wr.WriteInt(v.head.gap);
		wr.WriteString(v.foot.left);
		wr.WriteString(v.foot.right);
		wr.WriteInt(v.foot.gap);
		wr.WriteString(v.font.typeface);
		wr.WriteInt(v.font.size);
		wr.WriteSet(v.font.style);
		wr.WriteInt(v.font.weight);
		wr.WriteBool(v.alternate);
		wr.WriteBool(v.number.new);
		wr.WriteInt(v.number.first);
		wr.WriteBool(v.showFoot);
	END Externalize;
	
	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER; typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;

	BEGIN
		v.Internalize^(rd);
		IF ~rd.cancelled THEN
			rd.ReadVersion(minVersion, maxVersion, version);
			IF ~rd.cancelled THEN
				IF version = 0 THEN
					rd.ReadXString(v.head.left);
					rd.ReadXString(v.head.right); 
					v.head.gap := 5*mm;
					rd.ReadXString(v.foot.left);
					rd.ReadXString(v.foot.right);
					v.foot.gap := 5*mm;
					rd.ReadXString(typeface);
					rd.ReadXInt(size); 
					v.font := Fonts.dir.This(typeface, size * point, {}, Fonts.normal);
					rd.ReadXInt(v.number.first);
					rd.ReadBool(v.number.new);
					rd.ReadBool(v.alternate)
				ELSE
					rd.ReadString(v.head.left);
					rd.ReadString(v.head.right);
					rd.ReadInt(v.head.gap);
					rd.ReadString(v.foot.left);
					rd.ReadString(v.foot.right);
					rd.ReadInt(v.foot.gap);
					rd.ReadString(typeface);
					rd.ReadInt(size);
					rd.ReadSet(style);
					rd.ReadInt(weight);
					v.font := Fonts.dir.This(typeface, size, style, weight);
					rd.ReadBool(v.alternate);
					rd.ReadBool(v.number.new);
					rd.ReadInt(v.number.first);
					IF version = 2 THEN rd.ReadBool(v.showFoot) ELSE v.showFoot := FALSE END
				END
			END
		END
	END Internalize;

	PROCEDURE SetProp(v: View; msg: Properties.SetMsg);
		VAR p: Properties.Property;
			typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
			alt, sf: BOOLEAN; num: NumberInfo; h, f: Banner;
 	BEGIN
		p := msg.prop;
		WHILE p # NIL DO
			WITH p: Properties.StdProp DO
				IF Properties.typeface IN p.valid THEN typeface := p.typeface 
				ELSE typeface := v.font.typeface
				END;
				IF Properties.size IN p.valid THEN size := p.size 
				ELSE size := v.font.size
				END;
				IF Properties.style IN p.valid THEN style := p.style.val
				ELSE style := v.font.style
				END;
				IF Properties.weight IN p.valid THEN weight := p.weight 
				ELSE weight := v.font.weight
				END;
				DoChangeFontOp (v, Fonts.dir.This(typeface, size, style, weight) );
			| p: Prop DO
				IF alternate IN p.valid THEN alt := p.alternate ELSE alt := v.alternate END;
				IF showFoot IN p.valid THEN sf := p.showFoot ELSE sf := v.showFoot END;
				IF number IN p.valid THEN num := p.number ELSE num := v.number END;
				IF head IN p.valid THEN h := p.head ELSE h := v.head END;
				IF foot IN p.valid THEN f := p.foot ELSE f := v.foot END;
				DoChangeAttrOp(v, alt, sf, num, h, f)
			ELSE
			END;
			p := p.next
		END
	END SetProp;
	
	PROCEDURE PollProp(v: View; VAR msg: Properties.PollMsg);
		VAR sp: Properties.StdProp; p: Prop;
	BEGIN
		NEW(sp);
		sp.known := {Properties.size, Properties.typeface, Properties.style, Properties.weight};
		sp.valid := sp.known;
		sp.size := v.font.size; sp.typeface := v.font.typeface; 
		sp.style.val := v.font.style; sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
		sp.weight := v.font.weight;
		Properties.Insert(msg.prop, sp);
		NEW(p);
		p.known := {alternate, number, head, foot, showFoot}; p.valid := p.known;
		p.head := v.head; p.foot := v.foot;
		p.alternate := v.alternate;
		p.showFoot := v.showFoot;
		p.number := v.number;
		Properties.Insert(msg.prop, p)
	END PollProp;
	
	PROCEDURE PageMsg(v: View; msg: TextViews.PageMsg);
	BEGIN
		IF Printing.par # NIL THEN
			Dialog.MapString(v.head.left, Printing.par.header.left);
			Dialog.MapString(v.head.right, Printing.par.header.right);
			Dialog.MapString(v.foot.left, Printing.par.footer.left);
			Dialog.MapString(v.foot.right, Printing.par.footer.right);
			Printing.par.header.font := v.font;
			Printing.par.footer.font := v.font;
			Printing.par.page.alternate := v.alternate;
			IF v.number.new THEN
				Printing.par.page.first := v.number.first - msg.current
			END;
			Printing.par.header.gap := 5*Ports.mm;
			Printing.par.footer.gap := 5*Ports.mm
		END
	END PageMsg;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR d, w, h: INTEGER; (*line: Line; *)asc, dsc, x0, x1, y: INTEGER;
			win: Windows.Window; title: Views.Title; dec: BOOLEAN;
			pw, ph: INTEGER;
			date: Dates.Date; time: Dates.Time; pageInfo: Printing.PageInfo; banner: Printing.Banner;
	BEGIN
		IF Views.IsPrinterFrame(f) THEN (* am drucken *) END;

		v.font.GetBounds(asc, dsc, w);

		win := Windows.dir.First();
		WHILE (win # NIL) & (win.doc.Domain() # v.Domain()) DO win := Windows.dir.Next(win) END;
		IF win = NIL THEN title := "(" + Dialog.appName + ")"
		ELSE win.GetTitle(title)
		END;
		d := f.dot; 
		v.context.GetSize(w, h);
		win.doc.PollPage(pw, ph, l, t, r, b, dec);
		w := r - l;

		f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25);
		f.DrawRect(0, 0, w, h, 0, Ports.black);
		
		x0 := d; x1 := w-2*d; y := asc + d;

		Dates.GetDate(date);
		Dates.GetTime(time);
		pageInfo.alternate := FALSE;
		pageInfo.title := title;
		banner.font := v.font;		
		IF v.showFoot THEN
			banner.gap := v.foot.gap;
			Dialog.MapString(v.foot.left, banner.left); Dialog.MapString(v.foot.right, banner.right)
		ELSE
			banner.gap := v.head.gap;
			Dialog.MapString(v.head.left, banner.left); Dialog.MapString(v.head.right, banner.right)
		END;
		Printing.PrintBanner(f, pageInfo, banner, date, time, x0, x1, y)
	END Restore;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
		VAR asc, dsc, w: INTEGER;
	BEGIN
		WITH msg: Properties.SizePref DO
			msg.w := maxWidth; 
			IF msg.h = Views.undefined THEN
				v.font.GetBounds(asc, dsc, w);
				msg.h := asc + dsc + 2*point
			 END
		| msg: Properties.ResizePref DO
			msg.fixed := TRUE
		| msg: TextModels.Pref DO
			msg.opts := {TextModels.hideable}
		| msg: Properties.PollMsg DO
			PollProp(v, msg)
		| msg: Properties.SetMsg DO
			SetProp(v, msg)
		| msg: TextViews.PageMsg DO
			PageMsg(v, msg)
		ELSE
		END
	END HandlePropMsg;
	
	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																VAR focus: Views.View);
	BEGIN
		WITH msg: Properties.EmitMsg DO Views.HandlePropMsg(v, msg.set)
		| msg: Properties.CollectMsg DO Views.HandlePropMsg(v, msg.poll)
		ELSE
		END
	END HandleCtrlMsg;
	
	PROCEDURE New*(p: Prop; f: Fonts.Font): Views.View;
		VAR v: View;
	BEGIN
		NEW(v);
		v.head := p.head;
		v.foot := p.foot;
		v.number := p.number;
		v.alternate := p.alternate;
		v.font := f; 
		v.showFoot := FALSE;
		RETURN v;	
	END New;

	PROCEDURE Deposit*;
		VAR v: View;
	BEGIN
		NEW(v);
		v.head.left := ""; v.head.right :=  "&d&;&p"; v.head.gap := 5*mm;
		v.foot.left := ""; v.foot.right := ""; v.foot.gap := 5*mm;
		v.font := Fonts.dir.Default();
		v.number.first := 1; v.number.new := FALSE; v.alternate := FALSE; v.showFoot := FALSE;
		Views.Deposit(v)
	END Deposit;
	
	(* property dialog *)
	
	PROCEDURE InitDialog*;
		VAR  p: Properties.Property;
	BEGIN
		Properties.CollectProp(p);
		WHILE p # NIL DO
			WITH p: Properties.StdProp DO
			| p: Prop DO
				dialog.alternate := p.alternate; dialog.showFoot := p.showFoot;
				dialog.number := p.number;
				dialog.head := p.head; dialog.head.gap := dialog.head.gap DIV point;
				dialog.foot := p.foot; dialog.foot.gap := dialog.foot.gap DIV point;
				Dialog.Update(dialog)
			ELSE
			END;
			p := p.next
		END
	END InitDialog;
	
	PROCEDURE Set*;
		VAR p: Prop;
	BEGIN
		NEW(p); p.valid := {alternate, number, head, foot, showFoot};
		p.alternate := dialog.alternate; p.showFoot := dialog.showFoot;
		p.number := dialog.number;
		p.head := dialog.head; p.head.gap := p.head.gap * point;
		p.foot := dialog.foot; p.foot.gap := p.foot.gap * point;
		Properties.EmitProp(NIL, p)
	END Set;
	
	PROCEDURE HeaderGuard* (VAR par: Dialog.Par);
		VAR v: Views.View;
	BEGIN
		v := Containers.FocusSingleton();
		IF (v # NIL) & (v IS View) THEN
			par.disabled := FALSE;
			IF (dialog.view = NIL) OR (dialog.view # v) THEN
				dialog.view := v(View);
				InitDialog
			END
		ELSE
			par.disabled := TRUE;
			dialog.view := NIL
		END
	END HeaderGuard;
	
	PROCEDURE AlternateGuard* (VAR par: Dialog.Par);
	BEGIN
		HeaderGuard(par);
		IF ~par.disabled THEN par.disabled := ~ dialog.alternate END
	END AlternateGuard;
	
	PROCEDURE NewNumberGuard* (VAR par: Dialog.Par);
	BEGIN
		HeaderGuard(par);
		IF ~par.disabled THEN par.disabled := ~ dialog.number.new END
	END NewNumberGuard;
	
END StdHeaders.