Obx/Mod/Calc.odc

MODULE ObxCalc;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT Stores, Ports, Views, Properties, Controllers, Dialog, Fonts, Strings;

	CONST minVersion = 0; maxVersion = 0; mm = Ports.mm; CR = 0DX;

	TYPE
		Stack = POINTER TO RECORD
			next: Stack;
			val: INTEGER
		END;

		View = POINTER TO RECORD (Views.View)
			stack: Stack;
			editMode, enterMode: BOOLEAN
		END;

	VAR
		font: Fonts.Font;
		labels: ARRAY 21 OF CHAR;

	PROCEDURE LocateField (v: View; f: Views.Frame; x, y: INTEGER; VAR i, j: INTEGER;
											VAR valid: BOOLEAN);
	BEGIN
		x := x DIV mm - 3; y := y DIV mm - 12; i := SHORT(x DIV 9); j := SHORT(y DIV 9);
		valid := (i >= 0) & (i < 4) & (j >= 0) & (j < 5) & (x MOD 9 < 7) & (y MOD 9 < 7)
	END LocateField;

	PROCEDURE SelectField (v: View; f: Ports.Frame; i, j: INTEGER);
		CONST point = Ports.point;
		VAR x, y: INTEGER;
	BEGIN
		x := (3 + i * 9) * mm; y := (12 + j * 9) * mm;
		f.MarkRect(x + point, y + point, x + 6 * mm - point, y + 6 * mm - point, Ports.fill, Ports.hilite, TRUE)
	END SelectField;

	PROCEDURE HandleKey (v: View; i, j: INTEGER);
		VAR k, n: INTEGER; s: Stack;
	BEGIN
		k := j*4 + i; s := v.stack;
		IF k IN {0, 1, 2, 3, 7, 11, 15} THEN
			IF s.next # NIL THEN
				IF k = 0 THEN (* swap *) s := s.next; v.stack.next := s.next; s.next := v.stack; v.stack := s
				ELSIF k = 1 THEN v.stack := s.next
				ELSIF k IN {2, 3} THEN
					IF s.val = 0 THEN Dialog.Beep
					ELSIF k = 2 THEN s.next.val := s.next.val MOD s.val; v.stack := s.next
					ELSE s.next.val := s.next.val DIV s.val; v.stack := s.next
					END
				ELSIF k = 7 THEN s.next.val := s.next.val * s.val; v.stack := s.next
				ELSIF k = 11 THEN s.next.val := s.next.val - s.val; v.stack := s.next
				ELSIF k = 15 THEN s.next.val := s.next.val + s.val; v.stack := s.next
				END
			ELSE
				IF k = 0 THEN NEW(s); s.val := 0; s.next := v.stack; v.stack := s
				ELSIF k = 11 THEN s.val := -s.val
				ELSIF k = 15 THEN (* skip *)
				ELSE s.val := 0
				END
			END;
			v.editMode := FALSE
		ELSIF k = 18 THEN  (*  *) 
			s.val := - s.val
		ELSIF k = 16THEN (* delete *)
			IF v.editMode THEN s.val := s.val DIV 10
			ELSE s.val := 0; v.editMode := TRUE
			END
		ELSIF k = 19 THEN (* enter *)
			NEW(s); s.val := v.stack.val; s.next := v.stack; v.stack := s;
			v.editMode := FALSE
		ELSE (* edit operation *)
			IF k = 17 THEN (* 0 *) n := 0 ELSE n := (3-j)*3 + 1 + i END;
			IF ~v.editMode & ~v.enterMode THEN
				NEW(s); s.val := n; s.next := v.stack; v.stack := s; v.editMode := TRUE
			ELSIF ~v.editMode THEN s.val := n; v.editMode := TRUE
			ELSIF s.val >= 0 THEN
				IF s.val > (MAX(INTEGER) - n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val + n END
			ELSE 
				IF s.val < (MIN(INTEGER) + n) DIV 10 THEN Dialog.Beep ELSE s.val := 10*s.val - n END
			END
		END;
		v.enterMode := k = 19;
		Views.Update(v, Views.keepFrames)
	END HandleKey;

	PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);
		VAR i, j, i1, j1: INTEGER; isDown, valid, sel: BOOLEAN; m: SET;
	BEGIN
		LocateField(v, f, x, y, i, j, sel);
		IF sel THEN
			SelectField(v, f, i, j);
			REPEAT f.Input(x, y, m, isDown);
				LocateField(v, f, x, y, i1, j1, valid); 
				IF ~valid OR (i1 # i) OR (j1 # j) THEN
					IF sel THEN sel := FALSE; SelectField(v, f, i, j) END
				ELSE
					IF ~sel THEN sel := TRUE; SelectField(v, f, i, j) END
				END
			UNTIL ~isDown;
			IF sel THEN HandleKey(v, i, j); SelectField(v, f, i, j) END
		END
	END Track;

	PROCEDURE Init (v: View);
	BEGIN
		NEW(v.stack); v.stack.val := 0; v.editMode := TRUE; v.enterMode := FALSE
	END Init;

	(* View *)

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

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN Init(v) END
	END Internalize;

	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		Init(v)
	END CopyFromSimpleView;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR i, j: INTEGER; x, y, asc, dsc, w: INTEGER; s: ARRAY 2 OF CHAR;
			display: ARRAY 12 OF CHAR;
	BEGIN
		Strings.IntToStringForm(v.stack.val, Strings.decimal, 11, " ", FALSE, display);
		f.DrawRect(0, 0, 40 * mm, 58 * mm, 0, Ports.black);
		f.DrawRect(3 * mm, 3 * mm, 37 * mm, 10 * mm, 0, Ports.black);
		f.DrawString(6 * mm, 8 * mm, Ports.black, display, font);
		j := 0;
		WHILE j # 5 DO
			i := 0; y := (12 + j * 9) * mm;
			WHILE i # 4 DO
				x := (3 + i * 9) * mm;
				f.DrawRect(x, y, x + 6 * mm, y + 6 * mm, 0, Ports.black);
				f.DrawRect(x + mm, y + 6 * mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
				f.DrawRect(x + 6 * mm, y + Ports.mm, x + 7 * mm, y + 7 * mm, Ports.fill, Ports.black);
				s[0] := labels[j * 4 + i]; s[1] := 0X;
				font.GetBounds(asc, dsc, w);
				f.DrawString(x + 3 * mm - w DIV 2, y + 3 * mm + asc DIV 2, Ports.black, s, font);
				INC(i)
			END;
			INC(j)
		END
	END Restore;

	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																					VAR focus: Views.View);
		VAR i, j, k: INTEGER;
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			Track(v, f, msg.x, msg.y, msg.modifiers)
		| msg: Controllers.EditMsg DO
			IF msg.op = Controllers.pasteChar THEN
				IF msg.char = CR THEN k := 19
				ELSIF msg.char = 08X THEN k := 16
				ELSE
					k := 0; WHILE (k # 20) & (CAP(labels[k]) # CAP(msg.char)) DO INC(k) END
				END;
				IF k < 20 THEN
					i := k MOD 4; j := k DIV 4;
					SelectField(v, f, i, j); HandleKey(v, i, j); SelectField(v, f, i, j)
				END
			END
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
	BEGIN
		WITH msg: Properties.ResizePref DO
			msg.fixed := TRUE
		| msg: Properties.SizePref DO
			msg.w := 40 * mm; msg.h := 58 * mm
		| msg: Properties.FocusPref DO
			msg.setFocus := TRUE
		ELSE
		END
	END HandlePropMsg;

	(* commands *)

	PROCEDURE New* (): View;
		VAR v: View;
	BEGIN
		NEW(v); Init(v); RETURN v
	END New;

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

BEGIN 
	font := Fonts.dir.This("Courier", 11 * Fonts.point, {}, Fonts.normal);
	labels := "spч/789*456-123+C0^"
END  ObxCalc.