home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dream 52
/
Amiga_Dream_52.iso
/
Amiga
/
Applications
/
Mathematiques
/
IntCalc_1_11.lha
/
IntCalc
/
TXT
/
IntCalc.Mod
next >
Wrap
Text File
|
1993-02-01
|
44KB
|
1,884 lines
(* -----------------------------------------------------------------------------
| 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.