MODULE StdStamps;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20150617, center #62, Unicode and Internationalization support for StdStamps
	- 20151015, center #63, editing of old comments added plus some cleanups
	- 20160321, center #110, use mapped strings for labels in all forms
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		SYSTEM, (* SYSTEM.ROT only, for fingerprint calculation *)
		Dialog, Strings, Dates, StdCmds,
		Ports, Models, Stores, Containers, Properties, Views, Controllers, Fonts,
		TextModels, TextSetters, TextMappers, TextViews, TextRulers;

	CONST
		setCommentKey = "#Std:Set Comment";
		maxHistoryEntries = 25;	(* prepared for future expansion *)
		minVersion = 0; origStampVersion = 0; noSnrVersion = 1; snrVersion = 2; wideCommentVersion = 3; 
		maxVersion = 3;
		
	TYPE
		History = POINTER TO ARRAY OF RECORD
			fprint, snr: INTEGER;	(* fingerprint, sequence number *)
			date: INTEGER;			(* days since 1/1/1 *)
			time: INTEGER;			(* min + 64 * hour *)
			comment: POINTER TO ARRAY OF CHAR;	(* nil if no comment  *)
		END;
		
		Comment* = ARRAY 64 OF CHAR;
		
		StdView = POINTER TO RECORD (Views.View)
			(*--snr: LONGINT;   for version 1*)			
			nentries: INTEGER;	(* number of entries in history *)
			history: History;			(* newest entry in history[0] *)
			comment0: Comment;	(* comment for new history entry or empty *)
		END;

		SetCmtOp = POINTER TO RECORD (Stores.Operation)
			stamp: StdView;
			age: INTEGER;
			oldcomment: POINTER TO ARRAY OF CHAR;
		END;

	VAR
		comment*: RECORD
			stamp: StdView;
			snrList*: Dialog.List;
			date-: Dates.Date;
			s*: Comment;
		END;

	PROCEDURE (op: SetCmtOp) Do;
		VAR temp: POINTER TO ARRAY OF CHAR;
	BEGIN
		IF op.age = 0 THEN
			NEW(temp, LEN(op.stamp.comment0) + 1); temp^ := op.stamp.comment0$;
			op.stamp.comment0 := op.oldcomment^$
		ELSE
			temp := op.stamp.history[op.age - 1].comment;
			op.stamp.history[op.age - 1].comment := op.oldcomment
		END;
		op.oldcomment := temp;
	END Do;

	PROCEDURE FontContext (v: StdView): Fonts.Font;
		VAR c: Models.Context;
	BEGIN
		c := v.context;
		IF (c # NIL) & (c IS TextModels.Context) THEN
			RETURN c(TextModels.Context).Attr().font;
		ELSE
			RETURN Fonts.dir.Default()
		END;
	END FontContext;

	PROCEDURE CalcFP (t: TextModels.Model): INTEGER;
		CONST sglQuote = "'"; dblQuote = '"';
		VAR fp: INTEGER;  rd: TextModels.Reader; ch, quoteChar: CHAR; 
	BEGIN
		quoteChar := 0X; fp := 0;
		rd := t.NewReader(NIL); rd.ReadChar(ch);
		WHILE ~rd.eot DO
			IF ch = quoteChar THEN quoteChar := 0X;
			ELSIF (quoteChar = 0X) & ((ch = dblQuote) OR (ch = sglQuote)) THEN quoteChar := ch;
			END;
			IF (quoteChar = 0X) & (21X <= ch) & (ch # 8BX) & (ch # 8FX) & (ch # 0A0X) (* not in string literal *)
				OR (quoteChar # 0X) & (20X <= ch) (* within string literal *)
			THEN
				fp := SYSTEM.ROT(fp, 1) + 13 * ORD(ch);
			END;
			rd.ReadChar(ch);
		END;
		RETURN fp;
	END CalcFP;

	PROCEDURE FillComment (v: StdView; age: INTEGER; rebuild: BOOLEAN);
		VAR i: INTEGER; s: ARRAY 10 OF CHAR;
	BEGIN
		comment.stamp := v;
		IF rebuild THEN
			comment.snrList.SetLen(v.nentries + 1);
			comment.snrList.SetItem(0, "#Std:new");
			FOR i := 1 TO v.nentries DO
				Strings.IntToString(v.history[i - 1].snr, s);
				comment.snrList.SetItem(i, s);
			END ;
			comment.snrList.index := age;
			Dialog.UpdateList(comment.snrList)
		END;
		IF age = 0 THEN
			Dates.GetDate(comment.date);
			comment.s := v.comment0$
		ELSE DEC(age);
			Dates.DayToDate(v.history[age].date, comment.date);
			IF  v.history[age].comment = NIL THEN comment.s := '' ELSE comment.s := v.history[age].comment$ END
		END;
		Dialog.Update(comment)
	END FillComment;

	PROCEDURE Update (v: StdView; forcenew: BOOLEAN);
		VAR fp, ndays, i: INTEGER; d: Dates.Date; t: Dates.Time;
	BEGIN
		IF (v.context # NIL) & (v.context IS TextModels.Context) THEN
			fp := CalcFP(v.context(TextModels.Context).ThisModel());
			IF (fp # v.history[0].fprint) OR forcenew OR (v.comment0 # "") THEN
				Dates.GetDate(d); Dates.GetTime(t);
				ndays := Dates.Day(d);
				IF (ndays # v.history[0].date) OR forcenew THEN
					IF  v.nentries = LEN(v.history) THEN	(* find oldest uncommented entry *)
						i := LEN(v.history) - 1;
						WHILE (i > 0) & (v.history[i].comment # NIL) & (v.history[i].comment[0] # 0X) DO DEC(i) END;
						IF i = 0 THEN i := LEN(v.history) - 1 END
					ELSE i := v.nentries; INC(v.nentries)
					END;
					(* move down entries in history list *)
					WHILE i > 0 DO
						v.history[i] := v.history[i-1];
						DEC(i);
					END;
					v.history[0].comment := NIL
				ELSIF v.nentries = 0 THEN v.nentries := 1
				END;
				INC(v.history[0].snr);
				v.history[0].fprint := fp;
				v.history[0].date := ndays;
				v.history[0].time := t.minute + t.hour*64;
				IF v.comment0 # "" THEN
					NEW(v.history[0].comment, LEN(v.comment0$) + 1);
					v.history[0].comment^ := v.comment0$; v.comment0 := ""
				END;
				Views.Update(v, Views.keepFrames);
				IF comment.stamp = v THEN FillComment(v, 1, TRUE) END
			END;
		END;
	END Update;

	PROCEDURE HasWideChars (IN s: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ch: CHAR;
	BEGIN i := 0; ch := s[0];
		WHILE (ch # 0X) & (ch <= 0FFX) DO INC(i); ch := s[i] END;
		RETURN ch # 0X
	END HasWideChars;

	PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
		VAR i, len: INTEGER; version: INTEGER;
	BEGIN
		Update(v, v.comment0 # "");
		v.Externalize^(wr);
		i := 0; 
		WHILE (i < v.nentries) & ~((v.history[i].comment # NIL) & HasWideChars(v.history[i].comment)) DO
			INC(i)
		END;
		IF i < v.nentries THEN version := wideCommentVersion ELSE version := snrVersion END;
		wr.WriteVersion(version);
		(*--wr.WriteLInt(v.snr);*)
		wr.WriteXInt(v.nentries);
		FOR i := 0 TO v.nentries-1 DO
			wr.WriteInt(v.history[i].fprint);
			wr.WriteInt(v.history[i].snr);
			wr.WriteInt(v.history[i].date);
			wr.WriteXInt(v.history[i].time);
			IF (v.history[i].comment # NIL) & (LEN(v.history[i].comment$) > 0) THEN
				len := LEN(v.history[i].comment$);
				wr.WriteXInt(len);
				IF version >= wideCommentVersion THEN
					wr.WriteString(v.history[i].comment)
				ELSE
					wr.WriteXString(v.history[i].comment)
				END
			ELSE wr.WriteXInt(0);
			END
		END;
	END Externalize;

	PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER; format: BYTE; k, purge, i, len: INTEGER;
			d: Dates.Date; t: Dates.Time;
	BEGIN
		v.Internalize^(rd);
		IF ~rd.cancelled THEN
			rd.ReadVersion(minVersion, maxVersion, version);
			IF ~rd.cancelled THEN
				IF version = origStampVersion THEN (* deal with old StdStamp format *)
					(* would like to calculate fingerprint, but hosting model not available at this time *)
					NEW(v.history, maxHistoryEntries);
					v.history[0].fprint := 0;
					v.history[0].snr := 1; v.nentries := 1;
					rd.ReadXInt(d.year); rd.ReadXInt(d.month); rd.ReadXInt(d.day);
					rd.ReadXInt(t.hour); rd.ReadXInt(t.minute); rd.ReadXInt(t.second);
					rd.ReadByte(format); (* format not used anymore *)
					v.history[0].date := Dates.Day(d);
					v.history[0].time := t.minute + t.hour*64;
				ELSE
					IF version = noSnrVersion THEN NEW(v.history, maxHistoryEntries); rd.ReadInt(v.history[0].snr) END;
					rd.ReadXInt(v.nentries);
					IF version > noSnrVersion THEN NEW(v.history, MAX(v.nentries, maxHistoryEntries)) END;
					purge := 0;
					FOR k := 0 TO v.nentries - 1 DO
						i := k - purge;
						rd.ReadInt(v.history[i].fprint);
						IF version > noSnrVersion THEN rd.ReadInt(v.history[i].snr)
						ELSIF (* (version = noSnrVersion) & *) i > 0 THEN v.history[i].snr := v.history[i-1].snr - 1;
						END;
						rd.ReadInt(v.history[i].date);
						rd.ReadXInt(v.history[i].time);
						rd.ReadXInt(len);
						IF len > 0 THEN
							NEW(v.history[i].comment, len + 1);
							IF version >= wideCommentVersion THEN
								rd.ReadString(v.history[i].comment)
							ELSE
								rd.ReadXString(v.history[i].comment)
							END
						ELSE v.history[i].comment := NIL
						END;
						IF (i > 0) & (v.history[i].date = v.history[i-1].date) THEN
							(* purge uncommented entry if another entry for the same date exists *)
							IF v.history[i-1].comment = NIL THEN v.history[i-1].comment := v.history[i].comment; INC(purge)
							ELSIF v.history[i].comment = NIL THEN INC(purge)
							END
						END
					END;
					DEC(v.nentries, purge);
					IF version < wideCommentVersion THEN (* cleanup *)
						i := v.nentries - 1;
						WHILE (i > 0) & (v.history[i].date = 0) DO DEC(i); DEC(v.nentries) END
					END
				END
			END
		END
	END Internalize;

	PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);
		VAR i: INTEGER;
	BEGIN
		(* v.CopyFrom^(source); *)
		WITH source: StdView DO
			(*--v.snr := source.snr;*)
			v.nentries := source.nentries;
			v.comment0 := source.comment0;
			NEW(v.history, LEN(source.history));
			FOR i := 0 TO MAX(v.nentries - 1, 1) DO
				v.history[i] := source.history[i];
				IF source.history[i].comment # NIL THEN
					NEW(v.history[i].comment, LEN(source.history[i].comment$) + 1);
					v.history[i].comment^ := source.history[i].comment^$;
				END
			END
		END
	END CopyFromSimpleView;

	PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
			asc, dsc, fw: INTEGER; d: Dates.Date; date: ARRAY 32 OF CHAR; seq: ARRAY 8 OF CHAR;
	BEGIN
		c := v.context;
		IF (c # NIL) & (c IS TextModels.Context) THEN
			a := v.context(TextModels.Context).Attr();
			font := a.font;
			color := a.color
		ELSE font := Fonts.dir.Default(); color := Ports.black
		END;
		font.GetBounds(asc, dsc, fw);
		f.DrawLine(f.l, asc + f.dot, f.r, asc + f.dot, 1, Ports.grey25 );
		Dates.DayToDate(v.history[0].date, d);
		Dates.DateToString(d, Dates.plainAbbreviated, date);
		Strings.IntToStringForm(v.history[0].snr, Strings.decimal, 4, "0", FALSE, seq);
		f.DrawString(0, asc, color, date +  " (" + seq + ")", font)
	END Restore;

	PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
		VAR font: Fonts.Font; asc, dsc, w: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
	BEGIN
		font := FontContext(v);
		font.GetBounds(asc, dsc, w);
		d.day := 28; d.month := 1; d.year := 2222; p.w := 0;
		WHILE d.month <= 12 DO
			Dates.DateToString(d, Dates.plainAbbreviated, s);
			s := s + " (0000)";
			w := font.StringWidth(s);
			IF w > p.w THEN p.w := w END;
			INC(d.month)
		END;
		p.h := asc + dsc;
	END SizePref;

	PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
		VAR font: Fonts.Font; asc, w: INTEGER;
	BEGIN
		WITH msg: Properties.Preference DO
			WITH msg: Properties.SizePref DO
				SizePref(v, msg)
			| msg: Properties.ResizePref DO
				msg.fixed := TRUE
			| msg: Properties.FocusPref DO
				msg.hotFocus := TRUE
			| msg: TextSetters.Pref DO
				font := FontContext(v);
				font.GetBounds(asc, msg.dsc, w);
			ELSE
			END
		ELSE
		END
	END HandlePropMsg;

	PROCEDURE NewRuler (): TextRulers.Ruler;
		CONST mm = Ports.mm;
		VAR r: TextRulers.Ruler;
	BEGIN
		r := TextRulers.dir.New(NIL);
		TextRulers.SetRight(r, 140 * mm);
		TextRulers.AddTab(r, 15 * mm); TextRulers.AddTab(r, 35 * mm); TextRulers.AddTab(r, 75 * mm);
		RETURN r
	END NewRuler;

	PROCEDURE ShowHistory (v: StdView);
		VAR text: TextModels.Model; f: TextMappers.Formatter;
			i: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
			tv: TextViews.View; attr: TextModels.Attributes;
	BEGIN
		text := TextModels.dir.New();
		f.ConnectTo(text);
		attr := f.rider.attr;
		f.rider.SetAttr(TextModels.NewStyle(attr, {Fonts.italic}));
		Dialog.MapString("#Std:seq nr.", s); f.WriteString(s); f.WriteTab;
		Dialog.MapString("#Std:fingerprint", s); f.WriteString(s); f.WriteTab;
		Dialog.MapString("#Std:date and time", s); f.WriteString(s); f.WriteTab;
		Dialog.MapString("#Std:comment", s); f.WriteString(s); f.WriteLn;
		f.rider.SetAttr(attr); f.WriteLn;
		(*--n := v.snr;*)
		IF v.comment0 # "" THEN
			Dialog.MapString("#Std:new", s); f.WriteString(s); f.WriteTab; f.WriteTab;
			Dates.GetDate(d); Dates.DateToString(d, Dates.plainAbbreviated, s); f.WriteString(s);
			f.WriteTab; f.WriteString(v.comment0); f.WriteLn
		END ;
		FOR i := 0 TO v.nentries-1 DO
			f.WriteIntForm(v.history[i].snr, 10, 4, "0", FALSE);
			(*--DEC(n);*)
			f.WriteTab;
			f.WriteIntForm(v.history[i].fprint, TextMappers.hexadecimal, 8, "0", FALSE);
			f.WriteTab;
			Dates.DayToDate(v.history[i].date, d);
			Dates.DateToString(d, Dates.plainAbbreviated, s);
			f.WriteString(s);
			f.WriteString("  ");
			f.WriteIntForm(v.history[i].time DIV 64, 10, 2, "0", FALSE);
			f.WriteString(":");
			f.WriteIntForm(v.history[i].time MOD 64, 10, 2, "0", FALSE);
			IF v.history[i].comment # NIL THEN
				f.WriteTab;
				f.WriteString( v.history[i].comment^);
			END;
			f.WriteLn;
		END;
		tv := TextViews.dir.New(text);
		tv.SetDefaults(NewRuler(), TextViews.dir.defAttr);
		tv.ThisController().SetOpts({Containers.noFocus, Containers.noCaret});
		Views.OpenAux(tv, "History");
	END ShowHistory;

	PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);
		VAR c: Models.Context; w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
			d: Dates.Date; today, age: INTEGER;
	BEGIN
		c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
		REPEAT
			IF in # in0 THEN
				f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
			END;
			f.Input(x, y, m, isDown);
			in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
		UNTIL ~isDown;
		IF in0 THEN
			f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
			IF Controllers.modify IN m THEN
				Dates.GetDate(d); today := Dates.Day(d);
				IF (v.nentries = 0) OR (v.history[0].date # today) OR (v.comment0 # "") THEN age := 0 
				ELSE age := 1
				END;
				FillComment(v, age, TRUE);
				StdCmds.OpenToolDialog("Std/Rsrc/Stamps", "#Std:Comment");
			ELSE ShowHistory(v);
			END
		END
	END Track;

	PROCEDURE (v: StdView) HandleCtrlMsg (
				f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			Track(v, f, msg.x, msg.y, msg.modifiers)
		| msg: Controllers.PollCursorMsg DO
			msg.cursor := Ports.refCursor
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE GetActiveStamp (): StdView;
		VAR context: Models.Context;
	BEGIN
		IF comment.stamp # NIL THEN
			context := comment.stamp.context;
			IF context # NIL THEN
				IF context.ThisModel() = TextViews.FocusText() THEN RETURN comment.stamp END
			END
		END;
		RETURN NIL
	END GetActiveStamp;

	(* ------------ programming interface: ---------------------- *)

	PROCEDURE GetFirstInText* (t: TextModels.Model): Views.View;
		VAR r: TextModels.Reader; v: Views.View;
	BEGIN
		IF t # NIL THEN
			r := t.NewReader(NIL);
			REPEAT r.ReadView(v) UNTIL (v = NIL) OR (v IS StdView);
			RETURN v;
		ELSE RETURN NIL;
		END;
	END GetFirstInText;

	PROCEDURE IsStamp* (v: Views.View): BOOLEAN;
	BEGIN
		RETURN v IS StdView;
	END IsStamp;

	PROCEDURE GetInfo* (v: Views.View; OUT historylen: INTEGER);
	BEGIN
		ASSERT(v IS StdView, 20);
		WITH v: StdView DO
			historylen := v.nentries;
		END
	END GetInfo;

	PROCEDURE GetData* (v: Views.View; entryno: INTEGER;
				OUT snr, fprint: INTEGER; OUT date: Dates.Date; OUT time: Dates.Time; 
				OUT comment: ARRAY OF CHAR);
	BEGIN
		ASSERT(v IS StdView, 20);
		WITH v: StdView DO
			ASSERT(entryno < v.nentries, 21);
			snr := v.history[entryno].snr;
			fprint := v.history[entryno].fprint;
			Dates.DayToDate(v.history[entryno].date, date);
			time.hour := v.history[entryno].time DIV 64;
			time.minute := v.history[entryno].time MOD 64;
			time.second := 0;
			IF v.history[entryno].comment # NIL THEN comment := v.history[entryno].comment^$
			ELSE comment := ""
			END
		END
	END GetData;

	(** Insert new history entry with comment in v. *)
	PROCEDURE Stamp* (v: Views.View; IN comment: ARRAY OF CHAR);
	BEGIN
		ASSERT(v IS StdView, 20);
		WITH v: StdView DO
			Update(v, TRUE);
			NEW(v.history[0].comment, LEN(comment$) + 1);
			v.history[0].comment^ := comment$;
		END
	END Stamp;

	PROCEDURE New* (): Views.View;
		VAR v: StdView; d: Dates.Date; t: Dates.Time;
	BEGIN
		NEW(v); NEW(v.history, maxHistoryEntries); v.history[0].snr := 0; v.nentries := 0;
		v.history[0].fprint := -1;
		Dates.GetDate(d); Dates.GetTime(t);
		v.history[0].date := Dates.Day(d);
		v.history[0].time := t.minute + t.hour*64;
		RETURN v;
	END New;

	PROCEDURE SetComment*;
		VAR v: StdView; op: SetCmtOp;
	BEGIN
		v := GetActiveStamp();
		IF v # NIL THEN
			NEW(op); op.stamp := v; op.age := comment.snrList.index;
			NEW(op.oldcomment, LEN(comment.s$) + 1);
			op.oldcomment^ := comment.s$;
			Views.Do(v, setCommentKey, op)
		END
	END SetComment;

	PROCEDURE Deposit*;
	BEGIN
		Views.Deposit(New())
	END Deposit;

	PROCEDURE Guard* (VAR par: Dialog.Par);
	BEGIN
		par.disabled := GetActiveStamp() = NIL
	END Guard;

	PROCEDURE SnrNotifier* (op, from, to: INTEGER);
		VAR v: StdView;
	BEGIN
		IF op = Dialog.changed THEN
			FillComment(comment.stamp, comment.snrList.index, FALSE)
		END
	END SnrNotifier;

END StdStamps.
