(* -----------------------------------------------------------------------------
   |	Program:	IntCalc
   |	Description:	Calculator for 32-Bit-Integers to the binary-, octal-,
   |			decimal- and sedecimal-base.
   |	Author:		Stefan Schulz (StS)
   |	Address:	Kurt-Schumacher-Str. 48
   |			D-6750 Kaiserslautern (Germany)
   |	History:	V1.0   (StS) 17-Aug-92   /* Old name: CalcBoy */
   |			V1.01  (StS) 23-Sep-92   /* Old name: CalcBoy */
   |			   # removed modulo-0-guru-bug
   |			V1.10  (StS) 20-Jan-93
   |			   # splitted in english-, german- and locale-version
   |			   # (locale-version not yet implemented)
   |			V1.11  (StS) 07-Feb-93
   |			   # no more ugly font-mistakes using Kick since 2.0
   |			   # lightly changed surface under Kick since 2.0
   |	Copyright:	(c) 1992/93 by Stefan Schulz
   |			FREEWARE
   |	Language:	Modula-2
   |	Translator:	M2Amiga V4.0d Development System by A+L AG
   |	Remarks:	-
   |	Bugs:		none known
----------------------------------------------------------------------------- *)

(*$ DEFINE	English:= FALSE
    DEFINE	Locale := FALSE		*)

(*$ DEFINE	Small:= FALSE

    IF	Small
	StackChk   := FALSE
	RangeChk   := FALSE
	OverflowChk:= FALSE
	NilChk     := FALSE
	EntryClear := FALSE
	CaseChk    := FALSE
	ReturnChk  := FALSE
    ENDIF			*)

(*$	LargeVars  := TRUE	*) (* Muß Large sein!! (Standarteinstellung)  *)

MODULE	IntCalc;

(* Importe ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(*$	IF	Locale		*)
(*$	ELSIF	English		*)
IMPORT	e	: ErrorBoxEnglish,
	is	: IDCMPSupportEnglish;
(*$	ELSE			*)
IMPORT	e	: ErrorBoxDeutsch,
	is	: IDCMPSupportDeutsch;
(*$	ENDIF			*)


FROM	SYSTEM
	IMPORT	ADDRESS,	ADR,		ASSEMBLE,	CAST,
		BITSET,		LONGSET,	REG,		SETREG,
		LOADREGS,	SAVEREGS,	TAG;


FROM	Arts
	IMPORT	kickVersion,	thisTask,
		Assert,		BreakPoint,	Requester;


FROM	ASCII
	IMPORT	cr,	esc,	del,	bs,	csi;


FROM	Console
	IMPORT	consoleName,	RawKeyConvert;


FROM	Conversions
	IMPORT	StrToVal,	ValToStr;


FROM	DosD
	IMPORT	ctrlE,		ctrlF;


FROM	DosL
	IMPORT	Delay;


FROM	ExecD
	IMPORT	MemReqs,	MemReqSet,	read,
		IOStdReq,	IOStdReqPtr,	Message,	MsgPortPtr,
		Interrupt,	unknown;


FROM	ExecL
	IMPORT	Forbid,		Permit,		SetFunction,
		AllocMem,	FreeMem,
		OpenDevice,	CloseDevice,	DoIO,
		Wait,		Signal,		SetSignal,	FindTask,
		FindPort,	WaitPort,	GetMsg,		ReplyMsg,
		PutMsg;


FROM	ExecSupport
	IMPORT	CreatePort,	DeletePort,	CreateStdIO,	DeleteStdIO;


FROM	GadBoxD
	IMPORT	GadgetPtr,	EinGadget;


FROM	GadBoxL
	IMPORT	InitBoolean,	FreeGadget,	RefreshOne,	SetGadFont;


FROM	GadPaintBox
	IMPORT	DrawBoolean,	DrawBoxRel;


FROM	GraphicsD
	IMPORT	TextFontPtr,	TextAttr,
		FontStyles,	FontStyleSet,	FontFlags,	FontFlagSet;


FROM	GraphicsL
	IMPORT	RectFill,	SetAPen,
		OpenFont,	CloseFont,	SetFont;


FROM	ImageBox
	IMPORT	ImageClose,	ImageDepthBack,	ImageDepthFront,
		OhneImage2,	CycleImageStruktur;


FROM	Input
	IMPORT	inputName,	addHandler,	remHandler;


FROM	InputEvent
	IMPORT	InputEvent,	InputEventPtr,
		Qualifiers,	QualifierSet,	Class;


FROM	IntuitionD
	IMPORT	sysGadget,	close,		wUpFront,	wDownBack,
		NewWindow,	Window,		WindowPtr,	ScreenPtr,
		customScreen,	WaTags,
		WindowFlags,	WindowFlagSet,	IDCMPFlags,	IDCMPFlagSet,
		IntuiMessage,	IntuiMessagePtr;


FROM	IntuitionL
	IMPORT	intuitionBase,
		OpenWindow,	CloseWindow,	OpenWindowTagList,
		CloseScreen,	ScreenToBack,
		DisplayBeep,	RefreshGadgets,	DrawImage;


FROM	IOBox
	IMPORT	GlobalRPort,
		Jam1,		Jam2,		WriteText,	LeseMsg;


FROM	R
	IMPORT	A0,	A1,	A3,	A4,	D2;


FROM	ReplaceGads
	IMPORT	ReplaceWinGads;


FROM	String
	IMPORT	ANSICap,	ConcatChar,	DeleteChar,	Length;


FROM	UtilityD
	IMPORT	tagEnd,		TagItem;


(* Definitionen +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(* Texte *)

CONST	Program		= "IntCalc";
	Version		= "1.11";

	(* Info-Text *)
	Line1		= "/--------------------------------\\";
	Line2		= "       "+Program+" Version "+Version+"       ";
	Line3		= "\\--------------------------------/";
	Line5		= "     (c) Copyright 1992/93 by     ";
	Line6		= "       Stefan Schulz  (StS)       ";
(*$	IF	Locale		*)
(*$	ELSIF	English		*)
	Line8		= "   ! This Program is FREEWARE !   ";
	Line10		= "     For further Informations     ";
	Line11		= "   read the  Documentation-file   ";
	Line14		= "     - release  Mousebutton -     ";
(*$	ELSE			*)
	Line8		= "   Dieses Programm ist FREEWARE   ";
	Line10		= "    Für weitere  Informationen    ";
	Line11		= "         siehe  Anleitung         ";
	Line14		= "     - Maustaste  loslassen -     ";
(*$	ENDIF			*)

(*$	IF	Locale		*)
(*$	ELSIF	English		*)

	(* Schlaf-Text *)
	GoneToSleep	= "Have to go sleep! No Window possible!";

	(* Ende-Text *)
	ProgramAborted	= "Program aborted!";
	ThatsIt		= "That's it";

(*$	ELSE			*)

	(* Schlaf-Text *)
	GoneToSleep	= "Muß schlafen gehen! Kein Window möglich!";

	(* Ende-Text *)
	ProgramAborted	= "Programm beendet!";
	ThatsIt		= "Das War's";

(*$	ENDIF			*)



(* Rechnungsumgebung *)

CONST	(* Fehlerkonstante *)
	divideByZero	= -1;
	undefinedPower	= -2;
	stackOverflow	= -3;
	userBreak	= -4;

CONST
(*$	IF	Locale		*)
(*$	ELSIF	English		*)

	(* Calculator-Errormessages *)
	Error		= "ERROR: ";
	DivideByZero	= "Divide by Zero";
	UndefinedPower	= "Undefined Power";
	StackOverflow	= "Calculator-Stack-Overflow";
	UserBreak	= "Calculation stopped";

(*$	ELSE			*)

	(* Fehlertexte *)
	Error		= "FEHLER: ";
	DivideByZero	= "Division durch 0";
	UndefinedPower	= "Nicht definierte Potenz";
	StackOverflow	= "Rechnerstacküberlauf";
	UserBreak	= "Rechnung abgebrochen";

(*$	ENDIF			*)

TYPE	OpCodes		= ( ocNone, ocStop, ocBracket, ocSub, ocAdd,
			    ocDiv, ocMult, ocMod, ocPower
			  ); (* OpCodes *)

CONST	MinOpCode	= MIN (OpCodes);
	MaxOpCode	= MAX (OpCodes);

TYPE	AllOpCodes	= [MinOpCode..MaxOpCode];

TYPE	StackEltPtr	= POINTER TO StackElt;
	StackElt	= RECORD
			  next		: StackEltPtr;
			  CASE	number : BOOLEAN OF
			   | FALSE :
				opCode		: OpCodes;
			   | TRUE :
				value		: LONGINT;
			   END; (* case *)
			  END; (* StackElt *)

CONST	StackEltSize	= SIZE ( StackElt );

VAR	ActBase		: INTEGER;
	ActValue,
	MemValue	: LONGINT;
	ActOpCode	: OpCodes;
	Head		: StackEltPtr;

	Priority	: ARRAY AllOpCodes OF SHORTINT;

	NewNumber,
	OpCodeLast	: BOOLEAN;

	ActOpCodeText	: ARRAY [0..0] OF CHAR;
	ActValueText	: ARRAY [0..33] OF CHAR;


(* Nachrichtenempfang und -sendung *)

CONST	PortName	= Program + ".Port";
	CloseWinTaskName= Program + ".CWT";

CONST	(* Signale *)
	NOSIG		= LONGSET {};
	ENDPROGRAM	= LONGSET { 1 };	(* Für SleepHandler-Routine   *)
	CALC		= LONGSET { 2 };				    (**)
	CLOSEWINDOW	= LONGSET { 1 };	(* Für CloseWinTask           *)
	ACKNOWLEDGE	= LONGSET { 1 };	(* Für MyCloseScreen-Routine  *)

VAR	CalcPort	: MsgPortPtr;		(* Da kommen Nachrichten an   *)
	CalcReq		: IOStdReqPtr;		(* Damit Kommandieren wir     *)

	IntuiMsg	: IntuiMessage;		(* Patch<->Prog Kommunikation *)
	CloseScreenTask	: ADDRESS;		(* Der Task von MyCloseScreen *)
						(* ändert sich ständig        *)

VAR	WindowMsg	: is.IDCMPMessage;


(* Benutzeroberfläche *)

CONST	WindowTitle	= Program + " V" + Version;
	TopazName	= "topaz.font";

(*$	IF	Locale		*)
(*$	ELSIF	English		*)

	Binary		= "Binary";
	Octal		= "Octal";
	Decimal		= "Decimal";
	Sedecimal	= "Sedecimal";

(*$	ELSE			*)

	Binary		= "Binär";
	Octal		= "Oktal";
	Decimal		= "Dezimal";
	Sedecimal	= "Hexadezimal";

(*$	ENDIF			*)

TYPE	GadNames	= ( (* Ziffern *)
			    g0, g1, g2, g3, g4, g5, g6, g7,
			    g8, g9, gA, gB, gC, gD, gE, gF,
			    
			    (* Operationen *)
			    gBack, gClr, gCE,
			    gOpenBracket, gCloseBracket, gDiv, gMult,
			    gSub, gAdd, gEnter, gPower, gNeg, gMod,
			    gMR, gMS, gMsub, gMadd,
			    
			    (* Basis *)
			    gBase
			  ); (* GadNames *)

CONST	MinGadName	= MIN (GadNames);
	MaxGadName	= MAX (GadNames);

TYPE	AllGadgets	= [MinGadName..MaxGadName];


CONST	calcWinWidth	= 272;		(* innere Breite des Fensters         *)
	calcWinHeight	= 113;		(* innere Höhe des Fensters           *)


VAR
	CalcWinData	: NewWindow;
	CalcWin		: WindowPtr;
	WinTagList	: ARRAY [0..2] OF TagItem;
	BorderRPort	: ADDRESS;

	Gadgets		: ARRAY AllGadgets OF EinGadget;

	GlobalFontPtr	: TextFontPtr;
	GlobalFontAttr	: TextAttr;

	ActBaseText	: ARRAY [0..16] OF CHAR;

	LeftEdge,				(* Position des Fensters      *)
	TopEdge		: LONGINT;		(**)

	OldA4		: ADDRESS;		(* Für MyCloseScreen-Routine  *)
						(* und SleepHandler-Interrupt *)

	JmpCloseScreen	: POINTER TO ADDRESS;
	OwnCloseScreen,
	IntuiAdr	: ADDRESS;



(* -------------------------------------------------------------------------- *)
  (*
   |	Hier folgt eine Routine, die in CloseScreen eingepatcht wird.
   |	Eine unsaubere Lösung: Es werden Daten in den Programm-Code geschrieben!
   |	Wer eine sauberere (funktionierende) Version kennt, bitte melden!!
   *)

PROCEDURE MyCloseScreen;	(*$ EntryExitCode:= FALSE *)

 BEGIN (* MyCloseScreen *)
 
 ASSEMBLE (	MOVEM.L	D0-D7/A0-A6,-(SP)
		MOVEA.L	A0,A3
      END ); (* assemble *)

 SETREG ( A4, OldA4 );
 Forbid;
 
 IF	(CalcWin # NIL)
      & (REG(A3) = LONGINT(CalcWin^.wScreen))
  THEN	CloseScreenTask:= FindTask(NIL);
	Permit;
	PutMsg (CalcWin^.userPort, ADR(IntuiMsg));
	SETREG (D2,Wait(ACKNOWLEDGE));
	Forbid;
	CloseScreenTask:= NIL;
  END;
 
 Permit;
 
 ASSEMBLE (	MOVEM.L	(SP)+,D0-D7/A0-A6
		DC.W	$4EF9			(* OpCode für JMP Absolute    *)
      END ); (* assemble *)
 
 
(* ACHTUNG:   Prozedur wird NICHT beendet!!!                                  *)
 
 END MyCloseScreen;

(*     !!!  HIER AUF KEINEN FALL WAS ZWISCHENSCHREIBEN  !!!                   *)

PROCEDURE JmpToCloseScreen;		(*$ EntryExitCode:= FALSE *)
 BEGIN
 ASSEMBLE (	DC.L	0	(* Hier wird eine Adresse reingeschrieben!!   *)
      END );
 END JmpToCloseScreen;



(* -------------------------------------------------------------------------- *)

PROCEDURE InstallPatch;

 VAR	

 BEGIN (* InstallPatch *)
 
OwnCloseScreen:= ADR (MyCloseScreen);
 
IntuiAdr:= intuitionBase;			(* eigene CloseScreen-Routine *)
Forbid ();					(* einfädeln                  *)
JmpCloseScreen := ADR(JmpToCloseScreen);	(* Jump-Procedure-Adresse     *)
JmpCloseScreen^:= SetFunction (IntuiAdr, -66, OwnCloseScreen);		    (**)
Permit ();								    (**)
 
 END InstallPatch;



(* -------------------------------------------------------------------------- *)

PROCEDURE RemovePatch;

 VAR	ActCloseAdr	: ADDRESS;
	Ok		: BOOLEAN;

 BEGIN (* RemovePatch *)
 
 Ok:= TRUE;
 LOOP	(* Spart hier mehrere doppelte Aufrufe und Vergleiche *)
 
 IF JmpCloseScreen = NIL THEN EXIT  END;
 
 IF	CloseScreenTask = NIL
  THEN	Forbid;		(* Konfliktvermeidungsmultitaskingausschaltaufruf     *)
	ActCloseAdr:= SetFunction (IntuiAdr, -66, JmpCloseScreen^);
	IF	ActCloseAdr = OwnCloseScreen
	 THEN	Permit;
		EXIT;
	 ELSE	ActCloseAdr:= SetFunction (IntuiAdr, -66, JmpCloseScreen^);
	 END;
	Permit;		(* Sonst geht's schief                                *)
  END; (* if *)
 IF	Ok
  THEN	Ok:= e.ErrorCheck (WindowTitle, e.patchNotRemoved);
  ELSE	Delay (50);
  END; (* if *)

 END; (* loop <======= hier ist der Ausgang !!!! *)
 
 END RemovePatch;



(* -------------------------------------------------------------------------- *)

PROCEDURE InitDaten;

 BEGIN (* InitDaten *)
 
 ActBase      := 10;
 ActBaseText  := Decimal;
 ActOpCodeText:= " ";
 ActValueText := "0";
 NewNumber    := TRUE;
 OpCodeLast   := TRUE;
 
 Priority [ocNone]   := -1;
 Priority [ocStop]   := MAX (SHORTINT);
 Priority [ocBracket]:= 0;
 Priority [ocSub]    := 1;
 Priority [ocAdd]    := 1;
 Priority [ocDiv]    := 2;
 Priority [ocMult]   := 2;
 Priority [ocMod]    := 2;
 Priority [ocPower]  := 3;
 
 WITH	CalcWinData
   DO	leftEdge   := 0;
	topEdge    := 12;
	width      := 280;
	height     := 127;
	detailPen  := 0;
	blockPen   := 1;
	idcmpFlags := IDCMPFlagSet  { closeWindow,
				      rawKey, gadgetUp, mouseButtons,
				      activeWindow, inactiveWindow
				    };
	flags      := WindowFlagSet { windowClose, windowDrag, windowDepth,
				      activate, rmbTrap, gimmeZeroZero
				    };
	firstGadget:= ADR (Gadgets [MinGadName]);
	title      := ADR (WindowTitle);
	type       := customScreen;
	screen     := intuitionBase^.firstScreen;
	minWidth   := width;
	maxWidth   := width;
	minHeight  := height;
	maxHeight  := height;
	
	(* Bei Kick 1.x refresh "von Hand" ausführen *)
	IF	kickVersion < 36
	 THEN	INCL (flags, simpleRefresh);
		INCL (idcmpFlags, refreshWindow);
	 END;
  END; (* with *)
 
 (* -------------------------------------------------- *)
 (* Rom-Font Topaz 8 besorgen und in Gadgets einbinden *)
 (* -------------------------------------------------- *)
 
 WITH	GlobalFontAttr
   DO	name := ADR (TopazName);
	ySize:= 8;
	style:= FontStyleSet {};
	flags:= FontFlagSet {romFont};
  END; (* with *)
 
 GlobalFontPtr:= OpenFont (ADR(GlobalFontAttr));
 Assert (GlobalFontPtr # NIL, ADR(e.NoFont) );
 SetGadFont (GlobalFontAttr);
 
 (* ---------------------- *)
 (* Gadgets initialisieren *)
 (* ---------------------- *)
 
 Assert (   InitBoolean ( Gadgets [g0],
			  160, 97, 54, 15, ORD (g0),
			  23, 4, 1, ADR ("0\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE, TRUE, ADR (Gadgets [g1])
			)

	  & InitBoolean ( Gadgets [g1],
			  160, 81, 26, 15, ORD (g1),
			  9, 4, 1, ADR ("1\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g2])
			)

	  & InitBoolean ( Gadgets [g2],
			  188, 81, 26, 15, ORD (g2),
			  9, 4, 1, ADR ("2\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g3])
			)

	  & InitBoolean ( Gadgets [g3],
			  216, 81, 26, 15, ORD (g3),
			  9, 4, 1, ADR ("3\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g4])
			)

	  & InitBoolean ( Gadgets [g4],
			  160, 65, 26, 15, ORD (g4),
			  9, 4, 1, ADR ("4\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g5])
			)

	  & InitBoolean ( Gadgets [g5],
			  188, 65, 26, 15, ORD (g5),
			  9, 4, 1, ADR ("5\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g6])
			)

	  & InitBoolean ( Gadgets [g6],
			  216, 65, 26, 15, ORD (g6),
			  9, 4, 1, ADR ("6\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g7])
			)

	  & InitBoolean ( Gadgets [g7],
			  160, 49, 26, 15, ORD (g7),
			  9, 4, 1, ADR ("7\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g8])
			)

	  & InitBoolean ( Gadgets [g8],
			  188, 49, 26, 15, ORD (g8),
			  9, 4, 1, ADR ("8\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [g9])
			)

	  & InitBoolean ( Gadgets [g9],
			  216, 49, 26, 15, ORD (g9),
			  9, 4, 1, ADR ("9\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gA])
			)

	  & InitBoolean ( Gadgets [gA],
			  104, 17, 26, 15, ORD (gA),
			  9, 4, 1, ADR ("A\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gB])
			)

	  & InitBoolean ( Gadgets [gB],
			  132, 17, 26, 15, ORD (gB),
			  9, 4, 1, ADR ("B\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gC])
			)

	  & InitBoolean ( Gadgets [gC],
			  160, 17, 26, 15, ORD (gC),
			  9, 4, 1, ADR ("C\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gD])
			)

	  & InitBoolean ( Gadgets [gD],
			  188, 17, 26, 15, ORD (gD),
			  9, 4, 1, ADR ("D\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gE])
			)

	  & InitBoolean ( Gadgets [gE],
			  216, 17, 26, 15, ORD (gE),
			  9, 4, 1, ADR ("E\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gF])
			)

	  & InitBoolean ( Gadgets [gF],
			  244, 17, 26, 15, ORD (gF),
			  9, 4, 1, ADR ("F\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gBack])
			)

	  & InitBoolean ( Gadgets [gBack],
			  47, 33, 26, 15, ORD (gBack),
			  5, 4, 1, ADR ("<-"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gClr])
			)

	  & InitBoolean ( Gadgets [gClr],
			  75, 33, 40, 15, ORD (gClr),
			  8, 4, 1, ADR ("CLR"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gCE])
			)

	  & InitBoolean ( Gadgets [gCE],
			  117, 33, 40, 15, ORD (gCE),
			  12, 4, 1, ADR ("CE"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gOpenBracket])
			)

	  & InitBoolean ( Gadgets [gOpenBracket],
			  160, 33, 26, 15, ORD (gOpenBracket),
			  9, 4, 1, ADR ("(\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gCloseBracket])
			)

	  & InitBoolean ( Gadgets [gCloseBracket],
			  188, 33, 26, 15, ORD (gCloseBracket),
			  9, 4, 1, ADR (")\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gDiv])
			)

	  & InitBoolean ( Gadgets [gDiv],
			  216, 33, 26, 15, ORD (gDiv),
			  9, 4, 1, ADR ("÷\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMult])
			)

	  & InitBoolean ( Gadgets [gMult],
			  244, 33, 26, 15, ORD (gMult),
			  9, 4, 1, ADR ("×\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gSub])
			)

	  & InitBoolean ( Gadgets [gSub],
			  244, 49, 26, 15, ORD (gSub),
			  9, 4, 1, ADR ("-\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gAdd])
			)

	  & InitBoolean ( Gadgets [gAdd],
			  244, 65, 26, 15, ORD (gAdd),
			  9, 4, 1, ADR ("+\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gEnter])
			)

	  & InitBoolean ( Gadgets [gEnter],
			  244, 81, 26, 31, ORD (gEnter),
			  9, 11, 1, ADR ("=\o"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gPower])
			)

	  & InitBoolean ( Gadgets [gPower],
			  2, 65, 34, 15, ORD (gPower),
			  5, 4, 1, ADR ("x^y"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gNeg])
			)

	  & InitBoolean ( Gadgets [gNeg],
			  2, 81, 34, 15, ORD (gNeg),
			  5, 4, 1, ADR ("+/-"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMod])
			)

	  & InitBoolean ( Gadgets [gMod],
			  38, 81, 34, 15, ORD (gMod),
			  5, 4, 1, ADR ("MOD"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMR])
			)

	  & InitBoolean ( Gadgets [gMR],
			  104, 65, 26, 15, ORD (gMR),
			  5, 4, 1, ADR ("MR"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMS])
			)

	  & InitBoolean ( Gadgets [gMS],
			  104, 81, 26, 15, ORD (gMS),
			  5, 4, 1, ADR ("MS"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMsub])
			)

	  & InitBoolean ( Gadgets [gMsub],
			  76, 81, 26, 15, ORD (gMsub),
			  5, 4, 1, ADR ("M-"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gMadd])
			)

	  & InitBoolean ( Gadgets [gMadd],
			  132, 81, 26, 15, ORD (gMadd),
			  5, 4, 1, ADR ("M+"),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, ADR (Gadgets [gBase])
			)

	  & InitBoolean ( Gadgets [gBase],
			  2, 97, 156, 15, ORD (gBase),
			  28, 4, 1, ADR (ActBaseText),
			  1, 1, ADR (OhneImage2), NIL,
			  FALSE,TRUE, NIL
			)

	  , ADR (e.NoMemory)
	); (* Assert *)
 
 END InitDaten;



(* -------------------------------------------------------------------------- *)

PROCEDURE FreeAllGadgets;

 VAR	gad		: AllGadgets;

 BEGIN (* FreeAllGadgets *)
 
 FOR	gad:= MinGadName TO MaxGadName
  DO	FreeGadget (Gadgets[gad]);
  END;
 
 END FreeAllGadgets;



(* -------------------------------------------------------------------------- *)

PROCEDURE GetDevices;

 BEGIN (* GetDevices *)
 
 CalcPort:= CreatePort  (ADR(PortName), 0);
 CalcReq := CreateStdIO (CalcPort);
 Assert ((CalcPort # NIL) & (CalcReq # NIL), ADR (e.NoMemory));
 
 OpenDevice (ADR (inputName), 0, CalcReq, LONGSET {});
 Assert (CalcReq^.device # NIL, ADR (e.NoInputDevice));
 
 END GetDevices;



(* -------------------------------------------------------------------------- *)

PROCEDURE RemoveDevices;

 VAR	

 BEGIN (* RemoveDevices *)
 
 IF	CalcReq # NIL
  THEN	IF	CalcReq^.device # NIL
	 THEN	CloseDevice (CalcReq);
	 END;
	DeleteStdIO (CalcReq);
 END;
 IF	CalcPort # NIL
  THEN	DeletePort (CalcPort);
  END;
 
 END RemoveDevices;



(* -------------------------------------------------------------------------- *)

PROCEDURE Titleline	  (	active	    : BOOLEAN		);

 VAR	OldRPort	: ADDRESS;

 BEGIN (* Titelleiste *)
 
 IF	kickVersion < 36		(* Nur wenn kleine Kick 2.0           *)
  THEN	DrawBoolean (BorderRPort, 19, 0, 215, 11);	(* Fensterrahmen      *)
	
	IF	active
	 THEN	SetAPen (BorderRPort, 3);	(* Hintergrund füllen         *)
	 ELSE	SetAPen (BorderRPort, 0);				    (**)
	 END;
	RectFill (BorderRPort, 21, 1, 231, 9);	(* Titelleiste                *)
	
	OldRPort   := GlobalRPort;		(* Alten RastPort sichern     *)
	GlobalRPort:= BorderRPort;		(* Rahmen-RastPort laden      *)
	
	WriteText (23, 2, 2, 0, Jam1, WindowTitle);	(* Fenstertitel       *)
	
	GlobalRPort:= OldRPort;			(* Alten RastPort zurück      *)
  END; (* if *)
 
 END Titleline;


(* -------------------------------------------------------------------------- *)

PROCEDURE WindowSurface;

 VAR	x, y	: CARDINAL;

 BEGIN (* WindowSurface *)
 
 (* --------------------- *)
 (* Fensterinhalt löschen *)
 (* --------------------- *)
 
 SetAPen  (GlobalRPort, 0);
 RectFill (GlobalRPort, 0, 0, calcWinWidth-1, calcWinHeight-1 );
 
 (* --------------------------- *)
 (* Kick 1.x Ausnahmebehandlung *)
 (* --------------------------- *)
 
 IF	kickVersion < 36
  THEN	DrawBoolean (BorderRPort, 0, 11, 279, 159);	(* Fensterrahmen      *)
	SetAPen  (GlobalRPort, 2);
	RectFill (GlobalRPort, 0, 0, calcWinWidth-1, 0 );
  END;
 
 (* ------------------- *)
 (* Oberfläche zeichnen *)
 (* ------------------- *)
 
 FOR	x:= 160 TO 244 BY 28
  DO	FOR	y:= 33 TO 65 BY 16
	 DO	DrawBoolean (GlobalRPort, x, y, 26, 15);
	 END; (* for *)
  END; (* for *)
 
 FOR	x:= 76 TO 216 BY 28
  DO	DrawBoolean (GlobalRPort, x, 81, 26, 15);
	DrawBoolean (GlobalRPort, x + 28, 17, 26, 15);
  END; (* for *)
 
 DrawBoolean (GlobalRPort, 47, 33, 26, 15);
 DrawBoolean (GlobalRPort, 104, 65, 26, 15);
 
 DrawBoolean (GlobalRPort, 2, 65, 34, 15);
 DrawBoolean (GlobalRPort, 2, 81, 34, 15);
 DrawBoolean (GlobalRPort, 38, 81, 34, 15);
 
 DrawBoolean (GlobalRPort, 75, 33, 40, 15);
 DrawBoolean (GlobalRPort, 117, 33, 40, 15);
 
 DrawBoolean (GlobalRPort, 244, 81, 26, 31);
 DrawBoolean (GlobalRPort, 160, 97, 54, 15);
 
 DrawBoolean (GlobalRPort, 2, 97, 156, 15);
 
 DrawBoxRel  (GlobalRPort, 2, 2, 268, 13, FALSE);
 DrawBoxRel  (GlobalRPort, 2, 17, 20, 15, FALSE);
 DrawBoxRel  (GlobalRPort, 26, 17, 20, 15, FALSE);
 
 DrawImage   (GlobalRPort, ADR (CycleImageStruktur), 5, 100);
 
 RefreshGadgets (ADR (Gadgets [MinGadName]), CalcWin, NIL);
 
 END WindowSurface;



(* -------------------------------------------------------------------------- *)

PROCEDURE ShowDisplay;

 VAR	pos	: INTEGER;

 BEGIN (* ShowDisplay *)
 
 SetAPen  (GlobalRPort, 0);
 RectFill (GlobalRPort, 4, 5, 267, 13);
 pos:= (34 - Length(ActValueText)) * 8 - 5;
 WriteText (pos, 5, 1, 0, Jam2, ActValueText);
 WriteText (8, 21, 1, 0, Jam2, ActOpCodeText);
 
 IF	MemValue = 0
  THEN	WriteText (32, 21, 1, 0, Jam2, " \o" );
  ELSE	WriteText (32, 21, 1, 0, Jam2, "M\o");
  END;
 
 END ShowDisplay;



(* -------------------------------------------------------------------------- *)

PROCEDURE ShowInfo;

 BEGIN (* ShowInfo *)
 
 (* --------------------- *)
 (* Fensterinhalt löschen *)
 (* --------------------- *)
 
 SetAPen  (GlobalRPort, 0);
 RectFill (GlobalRPort, 0, 0, calcWinWidth-1, calcWinHeight-1);
 
 (* ------------------------ *)
 (* Info-Text draufschreiben *)
 (* ------------------------ *)
 
 WriteText (0, 0, 3, 0, Jam2, Line1);
 WriteText (0, 8, 3, 0, Jam2, Line2);
 WriteText (0, 16, 3, 0, Jam2, Line3);
 WriteText (0, 32, 1, 0, Jam2, Line5);
 WriteText (0, 40, 2, 0, Jam2, Line6);
 WriteText (0, 56, 3, 0, Jam2, Line8);
 WriteText (0, 72, 1, 0, Jam2, Line10);
 WriteText (0, 80, 1, 0, Jam2, Line11);
 WriteText (0, 104, 3, 0, Jam2, Line14);
 
 (* -------------------- *)
 (* Auf Maustaste warten *)
 (* -------------------- *)
 
 REPEAT	is.Receive (CalcWin, WindowMsg);
	(* Hier wird nix anderes als eine 'maus'-Nachricht beachtet *)
 UNTIL	( (WindowMsg.type = is.mtMouse) & (WindowMsg.Button = is.mbNone) );
 
 (* ------------------------------------ *)
 (* Alten Fensterinhalt wiederherstellen *)
 (* ------------------------------------ *)
 
 WindowSurface;
 ShowDisplay;
 
 END ShowInfo;



(* -------------------------------------------------------------------------- *)

PROCEDURE Push		  (	number	    : BOOLEAN		) : BOOLEAN;

 VAR	new	: StackEltPtr;

 BEGIN (* Push *)
 
 new:= NIL;
 new:= AllocMem (StackEltSize, MemReqSet{memClear});
 IF new = NIL THEN RETURN FALSE  END;
 
 new^.next  := Head;
 new^.number:= number;
 Head       := new;
 
 IF	number
  THEN	new^.value := ActValue;
  ELSE	new^.opCode:= ActOpCode;
  END; (* if *)
 
 RETURN TRUE;
 
 END Push;



(* -------------------------------------------------------------------------- *)

PROCEDURE Pop		  ()	: BOOLEAN;

 VAR	old	: StackEltPtr;

 BEGIN (* Pop *)
 
 IF	Head # NIL
  THEN	old := Head;
	Head:= Head^.next;
	IF	old^.number
	 THEN	ActValue := old^.value;
	 ELSE	ActOpCode:= old^.opCode;
	 END;
	
	FreeMem ( old, StackEltSize );
	
	RETURN TRUE;

  ELSE	RETURN FALSE;
  END; (* if *)
 
 END Pop;



(* -------------------------------------------------------------------------- *)

PROCEDURE ClearStack;

 VAR	old	: StackEltPtr;

 BEGIN (* ClearStack *)
 
 WHILE	Head # NIL
   DO	old := Head;
	Head:= Head^.next;
	FreeMem ( old, StackEltSize );
  END; (* while *)
 
 END ClearStack;



(* -------------------------------------------------------------------------- *)

PROCEDURE CalcError	  (	code	    : INTEGER		) : BOOLEAN;

 BEGIN (* CalcError *)
 
 CASE	code OF
  | divideByZero :
	ActValueText:= Error + DivideByZero;
  | undefinedPower :
	ActValueText:= Error + UndefinedPower;
  | stackOverflow :
	ActValueText:= Error + StackOverflow;
  | userBreak :
	ActValueText:= UserBreak;
  END;
 
 IF CalcWin = NIL THEN RETURN TRUE  END;
 
 ShowDisplay;
 
 REPEAT	is.Receive (CalcWin, WindowMsg );
	IF	WindowMsg.type = is.mtSystem
	 THEN	IF	activeWindow IN WindowMsg.Class
		 THEN	Titleline (TRUE);

		 ELSIF	inactiveWindow IN WindowMsg.Class
		  THEN	Titleline (FALSE);
		 END;
	 END; (* if *)

 UNTIL	( (WindowMsg.type = is.mtGadget) & (WindowMsg.GadgetID = ORD (gClr)) )
     OR ( (WindowMsg.type = is.mtKey)  & (WindowMsg.ASCII = del) )
     OR ( WindowMsg.type = is.mtClosed );
 
 ActValue         := 0;
 ActValueText     := "0";
 ActOpCode        := ocNone;
 ActOpCodeText [0]:= " ";
 NewNumber        := TRUE;
 ClearStack;
 
 RETURN	WindowMsg.type = is.mtClosed;
 
 END CalcError;



(* -------------------------------------------------------------------------- *)

PROCEDURE InChar	  (	digit	    : INTEGER		) : CHAR;

 BEGIN (* InChar *)
 
 IF	( digit > 0 ) & ( digit <= 9 )
  THEN RETURN	CHAR (ORD("0") + digit );
  ELSE RETURN	CHAR (ORD("A") - 10 + digit );
  END; (* if *)
 
 END InChar;



(* -------------------------------------------------------------------------- *)

PROCEDURE CanAddNum	  (	digit	    : INTEGER		) : BOOLEAN;

 TYPE	Multi	= RECORD
		  CASE	:BOOLEAN OF
		   | FALSE :
			i	: LONGINT;
		   | TRUE :
			c	: LONGCARD;
		   END; (* case *)
		  END; (* multi *)


 VAR	value	: Multi;
	err,
	sign	: BOOLEAN;

	m1	: LONGINT;
	m2	: LONGCARD;

 BEGIN (* CanAddNum *)
 
 StrToVal ( ActValueText, value.i, sign, ActBase, err );
 
 sign:= sign OR ( ActBase # 10 );
 
 m1:= MAX (LONGINT);
 m2:= MAX (LONGCARD);
 DEC ( m1, digit );
 DEC ( m2, digit );
 m1:= m1 DIV ActBase;
 m2:= m2 DIV LONGCARD ( ActBase );
 
 RETURN	   ( digit < ActBase )
	 & (    (~sign & (value.i <= m1))
	     OR (sign & (value.c <= m2))  );
 
 END CanAddNum;



(* -------------------------------------------------------------------------- *)

PROCEDURE POW		  ( VAR	Basis	    : LONGINT;
				Exponent    : LONGINT		) : BOOLEAN;

 VAR	cnt, erg	: LONGINT;
	Klasse		: IDCMPFlagSet;
	Code		: CARDINAL;
	Adresse		: ADDRESS;

	shut		: BOOLEAN;

 BEGIN (* POW *)
 
 (*$ OverflowChk:= FALSE *)

 shut:= FALSE;

 LOOP	(* Für Abbruchmöglichkeit bei zu langer Rechnung *)

 IF	Exponent > 0
  THEN	erg:= Basis;
	FOR	cnt:= 2 TO Exponent
	 DO	erg:= erg * Basis;
		IF	LeseMsg ( CalcWin^.userPort, Klasse, Code, Adresse )
		 THEN	IF	( closeWindow IN Klasse )
			     OR ( lonelyMessage IN Klasse )
			 THEN	erg:= 0;
				shut:= CalcError ( userBreak );
				EXIT;	(* cnt:= Exponent; ginge auch als
					   Abbruch, wäre aber nicht so
					   leicht sichtbar               *)
			 ELSIF	activeWindow IN Klasse
			  THEN	Titleline (TRUE);
			 ELSIF	inactiveWindow IN Klasse
			  THEN	Titleline (FALSE);
			 END; (* if *)
		 END; (* if *)
	 END; (* for *)
  ELSIF	( Exponent = 0 )
      & ( Basis # 0 )
   THEN	erg:= 1;
  ELSE	shut:= CalcError (undefinedPower);
  END; (* if *)

 EXIT;
 END; (* loop *)

 Basis:= erg;

 (*$ POP OverflowChk *)

 RETURN shut;

 END POW;



(* -------------------------------------------------------------------------- *)

PROCEDURE Evaluate	  (	operation   : OpCodes		) : BOOLEAN;

 VAR	zWert	: LONGINT;	(* Zwischenspeicher *)

	shut	: BOOLEAN;

 BEGIN (* Evaluate *)
 
 shut:= FALSE;
 WHILE	( Head # NIL )
      & ( ~Head^.number )
      & ( Priority [Head^.opCode] >= Priority [operation] )
   DO	zWert:= ActValue;
	IF	Pop ()				(* Operation vom Stack holen  *)
	 THEN	IF	ActOpCode > ocBracket
		 THEN	IF	Pop ()		    (* Zahl vom Stack holen   *)
			 THEN	CASE	ActOpCode OF	(* Rechnen            *)
				 | ocSub :
					(*$ OverflowChk:= FALSE *)
					DEC ( ActValue, zWert );
					(*$ POP OverflowChk *)
				 | ocAdd :
					(*$ OverflowChk:= FALSE *)
					INC ( ActValue, zWert );
					(*$ POP OverflowChk *)
				 | ocDiv :
					(*$ OverflowChk:= FALSE *)
					IF	zWert = 0
					 THEN	shut:= CalcError ( divideByZero )
					 ELSE	ActValue:= ActValue DIV zWert;
					 END; (* if *)
					(*$ POP OverflowChk *)
				 | ocMult :
					(*$ OverflowChk:= FALSE *)
					ActValue:= ActValue * zWert;
					(*$ POP OverflowChk *)
				 | ocMod :
					(*$ OverflowChk:= FALSE *)
					IF	zWert = 0
					 THEN	shut:= CalcError ( divideByZero )
					 ELSE	ActValue:= ActValue MOD zWert;
					 END; (* if *)
					(*$ POP OverflowChk *)
				 | ocPower :
					shut:= POW ( ActValue, zWert );
				 END; (* case *)
			 END; (* if *)
		 ELSIF	ActOpCode = operation
		  THEN	operation:= ocStop;
		 END; (* if *)
	 END; (* if *)
  END; (* while *)
 
 IF	~shut
  THEN	IF	operation > ocBracket
	 THEN	ActOpCode:= operation;
		IF	~Push ( TRUE )
		     OR ~Push ( FALSE )
		 THEN	shut:= CalcError (stackOverflow);
		 END;
	 ELSIF	operation = ocBracket
	  THEN	ActOpCode:= ocBracket;
		IF ~Push (FALSE) THEN shut:= CalcError (stackOverflow)  END;
	 END; (* if *)
  END; (* if *)
 
 RETURN shut;
 
 END Evaluate;



(* -------------------------------------------------------------------------- *)

PROCEDURE Eval		  (	id	    : INTEGER		) : BOOLEAN;

 VAR	int, int2	: INTEGER;
	card		: CARDINAL;
	sign, err, shut	: BOOLEAN;

 BEGIN (* Eval *)
 
 shut:= FALSE;
 IF	id = ORD ( g0 )			(* Eine Null ist gekommen             *)
  THEN	IF	~NewNumber
	 THEN	IF	CanAddNum ( id )
		 THEN	ConcatChar ( ActValueText, "0" );
		 END; (* if *)
		OpCodeLast:= FALSE;
	 ELSE	ActValueText:= "0";
		OpCodeLast:= FALSE;
	 END; (* if *)

  ELSIF	( id >= ORD (g1) ) & ( id <= ORD (gF) )	(* Kam eine Ziffer            *)
   THEN	IF	NewNumber
	 THEN	ActValueText:= "";
	 END; (* if *)
	IF	CanAddNum ( id )
	 THEN	ConcatChar ( ActValueText, InChar (id) );
		NewNumber:= FALSE;
		OpCodeLast:= FALSE;
	 ELSIF	NewNumber
	  THEN	ActValueText:= "0";
		OpCodeLast := FALSE;
	 END; (* if *)

  ELSIF	 id = ORD ( gBack )		(* Hat man sich vertan ?              *)
   THEN	int:= Length ( ActValueText );
	IF	~NewNumber & ( int > 0 )
	 THEN	DEC ( int );
		DeleteChar ( ActValueText, int );
	 END; (* if *)
	IF	int = 0
	 THEN	ActValueText:= "0";
		NewNumber   := TRUE;
		OpCodeLast := TRUE;
	 END; (* if *)
	
  ELSE	StrToVal ( ActValueText, ActValue, sign, ActBase, err );
	NewNumber:= TRUE;
	
	CASE	id OF
	
	 | ORD ( gClr ) :
		ClearStack;
		ActValue:= 0;
		ActOpCodeText [0]:= " ";
	
	 | ORD ( gCE ) :
		ActValue:= 0;
	
	 | ORD ( gOpenBracket ) :
		IF	( Head = NIL ) OR ~Head^.number
		 THEN	ActOpCode:= ocBracket;
			IF	~Push ( FALSE )
			 THEN	shut:= CalcError (stackOverflow);
			 END;
			ActOpCodeText [0]:= "(";
			ActValue          := 0;
		 END; (* if *)
		ActOpCodeText [0]:= " ";
	
	 | ORD ( gCloseBracket ) :
		shut:= Evaluate ( ocBracket );
		ActOpCodeText [0]:= " ";
	
	 | ORD ( gDiv ) :
		shut:= Evaluate ( ocDiv );
		ActOpCodeText [0]:= "/";
	
	 | ORD ( gMult ) :
		shut:= Evaluate ( ocMult );
		ActOpCodeText [0]:= "*";
	
	 | ORD ( gSub ) :
		shut:= Evaluate ( ocSub );
		ActOpCodeText [0]:= "-";
	
	 | ORD ( gAdd ) :
		shut:= Evaluate ( ocAdd );
		ActOpCodeText [0]:= "+";
	
	 | ORD ( gEnter ) :
		shut:= Evaluate ( ocNone );
		ActOpCodeText [0]:= " ";
	
	 | ORD ( gPower ) :
		shut:= Evaluate ( ocPower );
		ActOpCodeText [0]:= "^";
	
	 | ORD ( gNeg ) :
		ActValue:= - ActValue;
	
		SetAPen    ( GlobalRPort, 0 );
		RectFill   ( GlobalRPort, 30, 101, 154, 109 );
		RefreshOne ( ADR (Gadgets [gBase]), CalcWin );
		ActOpCodeText [0]:= " ";
	
	 | ORD ( gMod ) :
		shut:= Evaluate ( ocMod );
		ActOpCodeText [0]:= "\\";
	
	 | ORD ( gMR ) :
		ActValue:= MemValue;
	
	 | ORD ( gMS ) :
		MemValue:= ActValue;
	
	 | ORD ( gMsub ) :
		(*$ OverflowChk:= FALSE *)
		DEC ( MemValue, ActValue );
		(*$ POP OverflowChk *)
	
	 | ORD ( gMadd ) :
		(*$ OverflowChk:= FALSE *)
		INC ( MemValue, ActValue );
		(*$ POP OverflowChk *)
		
	
	 | ORD ( gBase ) :
		CASE	ActBase OF
		 |  2 :	ActBase    := 8;
			ActBaseText:= Octal;
		 |  8 :	ActBase    := 10;
			ActBaseText:= Decimal;
		 | 10 :	ActBase    := 16;
			ActBaseText:= Sedecimal;
		 | 16 :	ActBase    := 2;
			ActBaseText:= Binary;
		 END; (* case *)
		
		SetAPen    ( GlobalRPort, 0 );
		RectFill   ( GlobalRPort, 30, 101, 154, 109 );
		RefreshOne ( ADR (Gadgets [gBase]), CalcWin );
	
	  ELSE
	  END; (* case *)
	
	ValToStr   ( ActValue, ActBase = 10,
		     ActValueText, ActBase, -33, "\o", err );
	
  END; (* if *)
 
 ShowDisplay;
 
 RETURN shut;
 
 END Eval;



(* -------------------------------------------------------------------------- *)

PROCEDURE KeyEval	  (	key	    : CHAR;
				csi	    : BOOLEAN		) : BOOLEAN;

 BEGIN (* KeyEval *)
 
 IF	csi
  THEN	CASE	key OF
	 | esc :	(* Ende der Vorstellung *)
		csi:= TRUE;
	 | "U" :	(* Memory Read *)
		csi:= Eval ( ORD (gMR) );
	 | "D" :	(* Memory Store *)
		csi:= Eval ( ORD (gMS) );
	 | "L" :	(* Memory Minus *)
		csi:= Eval ( ORD (gMsub) );
	 | "R" :	(* Memory Plus *)
		csi:= Eval ( ORD (gMadd) );
	 | "?" :	(* Clear Entry *)
		csi:= Eval ( ORD (gCE) );
	 ELSE	csi:= FALSE;
	 END; (* case *)

  ELSE	key:= CAP ( key );
	CASE	key OF
	 | esc :	(* Schlafen gehen *)
		csi:= TRUE;
	 | cr, "=" :
		csi:= Eval ( ORD (gEnter) );
	 | del :
		csi:= Eval ( ORD (gClr) );
	 | bs :
		csi:= Eval ( ORD (gBack) );
	 | " " :
		csi:= Eval ( ORD (gBase) );
	 | "0".."9" :
		csi:= Eval ( ORD (g0) + ORD (key) - ORD ("0") );
	 | "A".."F" :
		csi:= Eval ( ORD (gA) + ORD (key) - ORD ("A") );
	 | "[", "{", "(" :
		csi:= Eval ( ORD (gOpenBracket) );
	 | "]", "}", ")" :
		csi:= Eval ( ORD (gNeg) );
	 | "/" :
		csi:= Eval ( ORD (gDiv) );
	 | "*" :
		csi:= Eval ( ORD (gMult) );
	 | "+" :
		csi:= Eval ( ORD (gAdd) );
	 | "-" :
		csi:= Eval ( ORD (gSub) );
	 | "M", "\\", "%" :
		csi:= Eval ( ORD (gMod) );
	 | "N" :
		csi:= Eval ( ORD (gNeg) );
	 | "H" :
		csi:= Eval ( ORD (gPower) );
	 ELSE	
	 END; (* case *)

  END; (* if *)
 
 RETURN csi;
 
 END KeyEval;



(* -------------------------------------------------------------------------- *)

PROCEDURE SleepHandler	  (	event {A0}  : InputEventPtr;
				data  {A1}  : ADDRESS		) : InputEventPtr;

 VAR	aktEvent,				(* Zum Durchlaufen der Events *)
	nextEvent,				(* Gedächtnisstütze           *)
	oldEvent	: InputEventPtr;	(* Zum merken des letzten     *)

(*$ SaveA4:= TRUE *)

 BEGIN (* SleepHandler *)
 
 SETREG ( A4, OldA4 );			(* Sonst klappt gar nichts mehr       *)
 
 Forbid;				(* Es kann nur einen geben            *)
 
 oldEvent:= NIL;
 aktEvent:= event;			(* "Zähler" initialisieren            *)
 WHILE	( aktEvent # NIL )		(* noch ein Event da?                 *)
   DO	nextEvent:= aktEvent^.nextEvent;	(* Nachfolger merken          *)
	IF	( rawkey = aktEvent^.class )	(* Ist es der Event           *)
	      & (    (lAlt IN aktEvent^.qualifier) (* meiner Sehnsucht ???    *)
		  OR (rAlt IN aktEvent^.qualifier) )			    (**)
	      & ( control IN aktEvent^.qualifier )			    (**)
	      & ( aktEvent^.code = 33H )				    (**)
	 THEN	IF	(lShift IN aktEvent^.qualifier)
		     OR (rShift IN aktEvent^.qualifier)
		 THEN	Signal (thisTask, ENDPROGRAM);	(* Ende-Code          *)
		 ELSE	Signal (thisTask, CALC);	(* Aufruf-Code        *)
		 END; (* if *)
		IF	oldEvent # NIL			(* war da schon was ? *)
		 THEN	oldEvent^.nextEvent:= nextEvent;  (* mein Event aus   *)
							  (* Liste entfernen  *)
		 ELSE	event:= nextEvent;		  (* war noch nix,    *)
							  (* Listenkopf neu   *)
		 END;
		aktEvent:= NIL;				(* kann aufhören      *)
	 END; (* if *)
	
	IF	aktEvent # NIL			(* Noch nix gefunden?         *)
	 THEN	oldEvent:= aktEvent;			(* dann weiter        *)
		aktEvent:= nextEvent;			(* suchen             *)
	 END;
	
  END; (* while *)
 
 Permit;				(* Jetzt dürfen andere ran            *)
 
 RETURN	event;				(* Der Rest den anderen               *)
 
 END SleepHandler;



(* -------------------------------------------------------------------------- *)

PROCEDURE SleepMode	  ()	: BOOLEAN;

 CONST	sleepName	= "CalcBoyInput";	(* So heißen wir              *)

 VAR	sleepInterrupt	: Interrupt;		(* Zum reinhängen             *)
	
	got		: LONGSET;		(* Was man haben will         *)

 BEGIN (* SleepMode *)
 
 WITH	sleepInterrupt			(* Interruptstruktur initialisieren   *)
   DO	node.succ:= NIL;						    (**)
	node.pred:= NIL;						    (**)
	node.type:= unknown;						    (**)
	node.pri := 60;				(* Prioritäten setzen         *)
	node.name:= ADR ( sleepName );		(* Einen Namen machen         *)
	data:= 0;							    (**)
	code:= ADR (SleepHandler);		(* Das ist unser Handler      *)
  END;
 
 CalcReq^.command:= addHandler;		(* Handler in Liste einhängen         *)
 CalcReq^.data   := ADR ( sleepInterrupt );				    (**)
 DoIO ( CalcReq );							    (**)
 
 got:= Wait ( ENDPROGRAM + CALC );	(* Warten auf gute Nachrichten        *)
 
 CalcReq^.command:= remHandler;		(* Handler aus dem Weg räumen         *)
 CalcReq^.data   := ADR ( sleepInterrupt );				    (**)
 DoIO ( CalcReq );							    (**)

 RETURN	got = ENDPROGRAM;		(* War es eine schlechte Nachricht?   *)
 
 END SleepMode;



(* -------------------------------------------------------------------------- *)

PROCEDURE OpenAll	  () : BOOLEAN;

 VAR	done	: BOOLEAN;

 (* ````````````````````````````````````````````````````````````````````````` *)
 
 PROCEDURE TryToOpen;
 
  VAR
 
  BEGIN (* TryToOpen *)
  
  IF	kickVersion < 36
   THEN	CalcWin:= OpenWindow (CalcWinData);
   ELSE	CalcWin:= OpenWindowTagList (ADR(CalcWinData),
				     TAG(WinTagList,
					 waInnerWidth,  calcWinWidth,
					 waInnerHeight, calcWinHeight,
					 tagEnd
					) (* TAG *)
				    ); (* OpenWindowTagList *)
   END; (* if *)
  
  END TryToOpen;
 
 (* ````````````````````````````````````````````````````````````````````````` *)

 BEGIN (* OpenAll *)
 
 CalcWinData.screen:= intuitionBase^.firstScreen;	(* Hier erscheinen    *)
 
 TryToOpen;
 IF	CalcWin = NIL				(* Hat nicht geklappt?        *)
  THEN	CalcWinData.leftEdge:= 0;		    (* nochmal in der Ecke    *)
	CalcWinData.topEdge := 0;		    (* versuchen              *)
	TryToOpen;							    (**)
  END;
 
 IF	CalcWin # NIL				(* Hat geklappt, Fenster da!  *)
  THEN	GlobalRPort:= CalcWin^.rPort;		(* RastPort zum reinmalen     *)
	BorderRPort:= CalcWin^.borderRPort;	(* Für Rahmenzeichnungen      *)
	
	(* ----------------------- *)
	(* Benutzte Font einbinden *)
	(* ----------------------- *)
	SetFont (GlobalRPort, GlobalFontPtr);
	
	(* ------------------------------- *)
	(* Nachrichten-Verbund vorbereiten *)
	(* ------------------------------- *)
	WITH	IntuiMsg
	  DO	execMessage.length   := 32;
		execMessage.replyPort:= CalcWin^.userPort;
		class                := IDCMPFlagSet { lonelyMessage };
		idcmpWindow          := CalcWin;
	 END; (* with *)
	
	(* ----------------------- *)
	(* System-Gadgets ersetzen *)
	(* ----------------------- *)
	done:= ReplaceWinGads (CalcWin, TRUE);
	
	(* ---------------------------------------- *)
	(* Titelzeile malen und Obefläche erstellen *)
	(* ---------------------------------------- *)
	Titleline (TRUE);
	WindowSurface;
	
	(* ---------------- *)
	(* Display anzeigen *)
	(* ---------------- *)
	ShowDisplay;
	
	RETURN TRUE;
  
  ELSE	(* Bescheid sagen und in den Schlafmodus wechseln *)
	RETURN	Requester ( ADR (WindowTitle), ADR (GoneToSleep),
			    NIL, ADR (e.Sorry)
			  ); (* Requester *)
  
  END; (* if *)
 
 END OpenAll;



(* -------------------------------------------------------------------------- *)

PROCEDURE CloseSurface;

 VAR	message		: Message;
	done		: BOOLEAN;

 BEGIN (* CloseSurface *)
 
 WITH	message
   DO	node.succ:= NIL;
	node.pred:= NIL;
	node.type:= unknown;
	node.pri := 0;
	node.name:= NIL;
	replyPort:= CalcPort;
	length   := 0;
  END;
 
 IF	CalcWin # NIL			(* Fenster da?                        *)
  THEN	done:= ReplaceWinGads (CalcWin,FALSE);		(* SysGadgets zurück  *)
	
	CalcWinData.leftEdge:= CalcWin^.leftEdge;	(* Position merken    *)
	CalcWinData.topEdge := CalcWin^.topEdge;			    (**)
	
	IntuiMsg.execMessage.replyPort:= NIL;
	CloseWindow (CalcWin);			(* Fenster zu, es zieht       *)
	CalcWin:= NIL;				(* Merken!                    *)
	
	IF	CloseScreenTask # NIL		(* Vollzug melden             *)
	 THEN	Signal (CloseScreenTask, ACKNOWLEDGE);			    (**)
	 END; (* if *)
  END; (* if *)
 
 END CloseSurface;



(* -------------------------------------------------------------------------- *)

PROCEDURE SayGoodBye	  ( VAR	NotDone	    : BOOLEAN		);

 BEGIN (* SayGoodBye *)
 
 IF	NotDone
  THEN	NotDone:= Requester ( ADR (WindowTitle), ADR (ProgramAborted),
			      NIL, ADR (ThatsIt)
			    ); (* Requester *)
  END; (* if *)
 
 END SayGoodBye;



(* HAUPTPROGRAMM ############################################################ *)

VAR	EndProg, Sleep	: BOOLEAN;

BEGIN	(* IntCalc *)

(* ----------------------------------------- *)
(* M2-Hauptregister für Patchroutine sichern *)
(* ----------------------------------------- *)
OldA4:= REG ( A4 );

(* -------------------------------------- *)
(* Nachschauen ob schon ein IntCalc läuft *)
(* -------------------------------------- *)
Assert (FindPort (ADR(PortName)) = NIL, ADR (e.StillRunning));

(* -------------- *)
(* Initialisieren *)
(* -------------- *)
GetDevices;
InitDaten;
InstallPatch;
Sleep:= ~OpenAll();

(* ----------------------------------------- *)
(* Interaktive Benutzeroberflächenverwaltung *)
(* ----------------------------------------- *)
EndProg:= FALSE;

REPEAT	IF	Sleep & ~EndProg
	 THEN	CloseSurface;
		EndProg:= SleepMode();
		Sleep  := (~EndProg & ~OpenAll());
	 
	 ELSE	is.Receive (CalcWin, WindowMsg);
		
		IF	WindowMsg.type = is.mtSystem
		 THEN	IF	activeWindow IN WindowMsg.Class
			 THEN	Titleline (TRUE);
			 ELSIF	inactiveWindow IN WindowMsg.Class
			  THEN	Titleline (FALSE);
			 ELSIF	refreshWindow IN WindowMsg.Class
			  THEN	Titleline (windowActive IN CalcWin^.flags);
				WindowSurface;
			 END; (* if *)
			Sleep  := closeWindow IN WindowMsg.Class;
			EndProg:=   Sleep
				  & (    (lShift IN WindowMsg.sSpecials)
				      OR (rShift IN WindowMsg.sSpecials));
		 
		 ELSIF	WindowMsg.type = is.mtGadget
		  THEN	Sleep:= Eval (WindowMsg.GadgetID);
		 
		 ELSIF	WindowMsg.type = is.mtMouse
		  THEN	IF	WindowMsg.Button = is.mbRight
			 THEN	ShowInfo;
			 END;
		 
		 ELSIF	WindowMsg.type = is.mtKey
		  THEN	Sleep  := KeyEval (WindowMsg.ASCII, WindowMsg.CSI);
			EndProg:= Sleep & WindowMsg.CSI;
		 
		 ELSIF	WindowMsg.type = is.mtClosed
		  THEN	Sleep:= TRUE;
		 
		 END; (* if *)
	 
	 END; (* if *)
	
UNTIL	EndProg;



CLOSE	(* *****      Benutzte Resourcen wieder freigeben               ***** *)

	ClearStack;
	CloseSurface;
	RemoveDevices;
	FreeAllGadgets;
	RemovePatch;

	SayGoodBye (EndProg);

END	IntCalc.