Heute werde ich mit der Programmierung des Rechnerbestandteils unseres Lovely Helpers beginnen. Leider auch wieder ein recht umfangreiches Unterfangen. Aus organisatorischen Gründen wird deshalb in dieser Folge zwar das komplette Listing abgedruckt, aber nur etwa bis zur Hälfte kommentiert. Der Rest folgt dann beim nächsten Mal. Heute werden wir uns mit dem Resource und seiner Verwaltung beschäftigen.
Da die Wechselwirkung zwischen Resource und Programm dabei etwas umfangreicher sein wird, reicht das als Programmpunkt für heute vollständig aus.
Einziger Bestandteil des Resources ist heute der Dialog RECHNER. Er ist hoffentlich in ausreichender Weise einem Taschenrechner nachempfunden (s. Abb. 24). Die Eingabe erfolgt über einen Satz von insgesamt 35 Feldtasten. Die Ausgabe - einschließlich diverser Statusanzeigen - erfolgt über insgesamt 10 Texte. Da die Feldtasten heute alle gleichartig sind - Flags Selectable & Exit - werde ich sie nicht, wie bisher, einzeln aufführen. Es sei auf die Abbildung verwiesen. Die Definitionen und die Semantik der verbleibenden Texte kann man aus Tabelle 1 entnehmen.
Bevor es an die Implementierung des Taschenrechners geht, möchte ich zunächst eine Aufgabenteilung vornehmen und ein wenig auf die zu erwartenden Probleme hinweisen. Dazu ist zu sagen, daß die Programmierung eines normalen Taschenrechners - “normal” hier im Sinne von Punkt-vor-Strich-Rechnung, Klammerung etc. - eine ganze Reihe von kleineren Tricks erforderlich macht.
Wie wir in der nächsten Folge sehen werden, kommen wir dabei nicht um die Benutzung von Stacks zur Berücksichtigung der Prioritäten (Klammem, Punkt-vor-Strich) herum. Eine weitere Problematik liegt darin begründet, daß beim Betrieb eines (guten) Taschenrechners eine ganze Reihe von Konventionen einzuhalten ist. Als Beispiel möchte ich die kurze Kommandosequenz 2 + = nennen. Von ihr würde man etwa erwarten, daß 2 + 2 = berechnet wird, also der zweite (nicht eingegebene) Operand aus dem Kontext gefolgert wird. Auch dies sollten wir bei der Konstruktion unseres Rechners berücksichtigen.
Wegen der Vielschichtigkeit dieser Probleme werden wir die Verarbeitung der von der Tastatur (Dialog) kommenden Befehle aufteilen. Und zwar in Editbefehle - sie beziehen sich ausschließlich auf das Edieren des momentan aktuellen Wertes - und Operatorbefehle - sie dienen der Eingabe von Operationen unter Einhaltung der Prioritäten.
Zum reinen Edieren dienen dabei die zehn Ziffern (BNULL - BNEUN), der Dezimalpunkt (BKOMMA), die Taste zum Vorzeichenwechsel (BVZW), die Exponentialtaste (BEXP), die Löschtaste (BC), die Taste zur Wahl des Berechnungsmodus’ der trigonometrischen Funktionen (BMOD) sowie die Taste zur Wahl der inversen Funktionen (BINV).
Sämtliche übrigen Tasten - die Funktionstasten, die Klammem und die Grundrechenarten - sind Operatorbefehle. Demzufolge läßt sich die Arbeit des Taschenrechners ebenfalls unterteilen in einerseits das Edieren von Zahlen mit abschließender Operatoreingabe und andererseits in die Abarbeitung von Sequenzen derartiger Wert-/Operatorpaare. An der Schnittstelle, zwischen diesen beiden Teilen müssen sowohl Werte als auch Operatorsymbole übergeben werden.
Beispiel: Die Berechnung von (1 + 2)* 3 = würde in folgenden Portionen erfolgen:
Nr. | Wert | Operator |
---|---|---|
1. | _ | ( |
2. | 1 | + |
3. | 2 | ) |
4. | _ | * |
5. | 3 | = |
Das Zeichen steht dabei für einen leeren Wert. Als zusätzlicher Parameter ist also auch noch ein Wahrheitswert zu übergeben, der die Gültigkeit des Operators angibt. Wenn wir uns dem Listing 14 zuwenden, lassen sich diese Parameter in der Prozedur do_edit (Zeilen 131-499) wiederfinden. Wert und Operator werden dabei direkt über die Parameterliste übergeben, der Wahrheitswert über die Variable gueltig (ein Seiteneffekt von do_edit).
Mit dem Inneren von do_edit sowie den Variablen und Operationen, auf die sich besagte Prozedur abstützt, wollen wir uns nun beschäftigen. Die ersten Deklarationen von Interesse, sind damit heute die Konstanten des zweiten Konstantenblocks (Zeilen 14-19).
Objekt | Objekttyp | Länge | Semantik |
---|---|---|---|
TVZ | TEXT | 1 | Vorzeichen der Mantisse |
TMANT | TEXT | 8 | Mantisse |
TEXPTEXT | TEXT | 1 | Anzeige des Exponentialmodus |
TEXPVZ | TEXT | 1 | Vorzeichen des Exponenten |
TEXPEXP | TEXT | 2 | Exponent |
TINV | TEXT | 3 | Statusanzeige Invers |
TM | TEXT | 1 | Speicher enthält Wert |
TDEG | TEXT | 3 | Winkelfunktionen in Grad |
TRAD | TEXT | 3 | Winkelfunktionen in Bogenmaß |
TGRAD | TEXT | 4 | Winkelfunktionen in Altgrad (in USA üblich) |
Tabelle 1: Die Object-Daten für den Dialog RECHNER (Abb. 24)
Die Bedeutung von pi dürfte wohl klar sein. Die nächsten drei Konstanten stehen für die drei Maßeinheiten, mit denen in den trigonometrischen Funktionen gerechnet werden kann (deg, rad, grad). Die beiden letzten Konstanten kennzeichnen den Status der Inverstaste (an, aus).
Der einzige Typ von Interesse ist heute op_type. Er beschreibt das Vokabular, das von der abstrakten Maschine, der nächsten Folge, verstanden werden muß, um die Wert-/Operatorpaare interpretieren zu können. An der Schnittstelle von do_edit haben wir deshalb für die Übergabe der Operatoren in dieser Form zu sorgen.
Bei den Variablen interessieren uns zunächst die Statusvariablen des Taschenrechners (Zeilen 43-46). Sie besitzen folgende Bedeutung:
error kennzeichnet den Fehlerstatus. Aus der Tabelle 2 können Sie entnehmen, welche möglichen Belegungen für error existieren.
inv_modus und tri_modus nehmen den jeweiligen Status der Invers- und der Modustaste auf. In Abhängigkeit vom tri_modus schwankt auch der Wert von t_faktor. Diese Variable wird nämlich benutzt, um die trigonometrischen Funktionen allgemeingültig zu formulieren.
Die nächste Rechnerstatusvariable ist speicher. In ihr wird die eine (!) Speicherstelle unseres Taschenrechners aufbewahrt. Dabei wird die Konvention getroffen, daß der Speicher als leer gilt, wenn sein Wert Null beträgt.
first_rechner ist eine Variable, die angibt, ob unser Rechnerdialog neu auf dem Bildschirm ist oder sich noch hier befindet. In Abhängigkeit hiervon wird nämlich entschieden, ob der Dialog nur wieder ausgeführt werden muß (redo_dialog) oder noch komplett zu zeichnen ist (do_dialog).
gueltig ist der bereits besprochene Wahrheitswert, der angibt, ob eine edierte Zahl auch in die Berechnung eingeht.
Der nächste Variablenblock (Zeilen 51-60) ist schnell erklärt. Er beinhaltet die Strings, die später die Texte für das Ausgabefeld aufnehmen. Die Zuordnung dürfte mnemotechnisch klar sein.
Kommen wir zum Operationendeklarationsteil von do_rechner. Die erste hier angesiedelte Prozedur, setze_texte (Zeilen 62-82), dient der bereits hinlänglich behandelten Aufgabe, einen Dialog zu initialisieren. Dazu werden die gerade besprochenen Stringvariablen des letzten Variablenblocks in unseren heutigen Dialog eingetragen.
Die nächste Prozedur, setze_redraw (Zeilen 84-97), hat nun dafür zu sorgen, daß die redraw-Bits sämtlicher Textfelder gesetzt werden. Damit wird GEM bei der wiederholten Ausführung des Rechnerdialogs (redo_dialog) gezwungen, die Textfelder neu zu zeichnen. Leider geschieht diese Neuzeichnung nicht automatisch, wenn nur der Textstring geändert wird. Es muß - wie im Listing - manuell nachgeholfen werden.
Die letzte, kleinere Prozedur vor do_edit ist do_error (Zeilen 99-129). Sie hat die Aufgabe, gemäß dem Fehlerstatus die entsprechende Fehlerkennung in die Dialogtexte einzutragen und den Dialog einmal auszuführen, um für die Fehlerausgabe anzuhalten. Dabei wird die Bedeutung von first_rechner ersichtlich (siehe auch oben). Es dient dazu, daß der Rechnerdialog nur beim ersten Mal komplett gezeichnet wird, bei weiteren Aufrufen erfolgt lediglich eine Neuzeichnung der veränderten Dialogeinträge. Der Ratschlag des ST Pascal-Handbuches, die redraw-Anweisung bei obj_setstate betreffend, ist sehr wörtlich zu nehmen! Das redraw-Bit darf nur gesetzt werden, wenn der Dialog schon auf dem Bildschirm vorhanden ist. Wird es bei nichtvorhandenem Dialog gesetzt, hat das zur Folge, daß bei jedem redo_dialog trotz gegensätzlicher Angaben der komplette Dialog neu gezeichnet wird.
Kommen wir nun zu unserer eigentlichen heutigen Aufgabe, der Prozedur do_edit. Über die Bedeutung ihrer Parameter haben wir ja bereits gesprochen. Nun geht es ans Eingemachte.
do_edit hat vier Konstanten, die angeben, welchen Status die im Moment edierte Zahl besitzt. Zur Auswahl stehen: fertig, vorkomma, nachkomma und exponent. Die lokale Variable status nimmt genau einen dieser Werte auf.
Zwei Kernstücke von do_edit möchte ich Ihnen etwas detaillierter vorstellen. Es handelt sich dabei um die beiden Operationen setze_zahl (Zeilen 142-298) und get_zahl (Zeilen 300-349).
Die erste dieser beiden Operationen - setze_zahl - initialisiert die Ausgabetexte, entsprechend der edierten Zahl, also eine Umwandlung von real in string. Da wir dabei ein ziemlich “verteiltes” Stringformat haben, scheiden leider die eingebauten ST Pascal-Operationen für diese Aufgabe aus. Also liegt die komplette Umwandlung in unserer Hand, setze_zahl unterscheidet dazu zunächst zwischen zwei Formaten: ganzzahlig und exponential.
Die ganzzahlige Darstellung wird dabei automatisch für ganze Zahlen unterhalb einer Million gewählt. Alle übrigen Zahlen werden exponential dargestellt. Unabhängig vom Format kann jedoch das Vorzeichen bestimmt werden (Zeilen 191-195). Die ganzzahlige Darstellung erfolgt, sind die notwendigen Bedingungen erfüllt (Zeile 196-197), in den Zeilen 199-214. Für die exponentiale Darstellung wird dagegen die Prozedur exp_darstellung (Zeilen 147-188) benutzt. Sie trennt Mantisse und Exponent und formt beide separat in Strings um. Die Details dieser beiden Transformationen seien dabei dem interessierten Leser überlassen.
Wir wollen nun noch die korrespondierende Funktion - get_zahl, die Umwandlung von string nach real - betrachten. Sie besitzt einen einfacheren Aufbau als setze_zahl. So erkennt man beispielsweise leicht, daß die Zeilen 315-321 den Vorkommateil der Zahl berechnen, die Zeilen 322-330 den Nachkommateil.
In 332 und 333 wird dann noch das Vorzeichen zugegeben.
Auch der Exponent berechnet sich ähnlich. Man muß hier allerdings darauf achten, daß kein Überlauf stattfindet, denn der Typ real nimmt unter Pascal+ maximal Werte bis zu 1e38 auf. Die Bedingung für die Abschätzung eines Überlaufs ist recht interessant (Zeile 344). Sie wird in ähnlicher Form sehr häufig beim nächsten Mal benutzt werden.
Die weiteren lokalen Operationen do_edits sind weniger aufwendig und schnell erklärt:
rsc_char berechnet mit einem CASE die einem Resourceangelpunkt zugeordnete Ziffer in Form eines Charakters.
get_operator hingegen wandelt die Angelpunkte in die schon besprochenen Operatorsymbole um.
Kommen wir nun zum Anweisungsteil von do_edit (Zeilen 351 -499). Hier erfolgen zuerst einige Initialisierungen. Allen voran die des Gültigkeitbits für die Wertübergabe (Zeile 352). Es ist auf false zu setzen, denn ediert haben wir ja noch nichts. Der status bekommt als Initialwert “fertig” (Zeile 353). Erst wenn eine Eingabe getätigt wurde, kann in eines der drei anderen Stadien übergegangen werden. Als letzter Schritt der Initialisierung wird die übergebene Zahl in die Textstrings eingetragen (Zeile 354). Der Rechner tritt daraufhin in eine REPEAT-Schleife (Zeilen 355-496) ein, die nur durch Selektion eines Operatorsymbols wieder verlassen werden kann. In dieser Schleife erfolgt zunächst eine Eingabe mittels des Dialoges. (Dabei ist wieder das first_rechner-Bit zu beachten.)
Anschließend erfolgt die Auswertung mit einem sehr umfangreichen CASE-Statement. Im Verlauf dieses CASE-Statements sieht man, wie der Rechner auf die unterschiedlichen Eingaben reagiert:
Der tri_modus wird um eine Position weitergeshiftet. In Abhängigkeit von diesem Ergebnis werden die entsprechenden Texte neu gesetzt sowie der t_faktor neu berechnet.
Der inv_modus wird neu gesetzt und der entsprechende Text umgesetzt.
Bei der Selektion einer Ziffer gibt es, entsprechend den vier Stadien des Editvorganges, vier Möglichkeiten der Reaktion.
War der vormalige Status fertig, werden nun sämtliche Ausgabestrings initialisiert, und dem ersten Wert der Mantisse wird der Wert der ausgewählten Feldtaste zugewiesen. Der Status wechselt dabei nach vorkomma.
War der Status vorkomma, ist zunächst zu überprüfen, ob noch Platz für weitere Eingaben vorhanden ist. Wenn ja, wird die eingegebene Ziffer von rechts mit der Mantisse verschmolzen.
Beim nachkomma-Status ist auch als erstes zu überprüfen, ob noch genügend Raum vorhanden ist. Wenn ja, wird die Ziffer ebenfalls an den Wert angehängt.
Im Status exponent ist lediglich die Fallunterscheidung zu treffen, ob der Exponent bisher leer war. Ist dies der Fall, wird die erste Ziffer des Exponential-Strings neu belegt, andernfalls die zweite.
BKOMMA hat nur im vorkomma- und im fertig-Modus eine Wirkung. Im vorkomma-Modus wird, falls Platz vorhanden ist, bewirkt, daß ein Punkt an die Mantisse angehängt wird. Im fertig-Modus wird die Mantisse mit dem Wert Null gefüllt und sämtliche anderen Strings initialisiert. Bei beiden Modi ist es jedoch erforderlich. mit dem Status nach nachkomma zu wechseln.
Ein Vorzeichenwechsel muß, je nach Status, für den Exponenten (exponent), oder für die Mantisse (fertig, vorkomma, nachkomma) vorgenommen werden.
Nr. | Fehlerart |
---|---|
0 | kein Fehler |
1 | Rechnerüberlauf |
2 | Division durch 0 |
3 | Definitionsbereich verletzt |
4 | Klammerfehler |
Tabelle 2: Statusmöglichkeiten für die Variable error
Allen Modi ist bei der Betätigung von BEXP gleich, daß in den exponent-Modus übergewechselt wird und die entsprechenden Strings initialisiert werden. Beim Status fertig wird zusätzlich davon ausgegangen, daß eine Mantisse von Eins erwünscht ist, da die Mantisse Null keinen Sinn macht - wieder eine der Konventionen zur Verbesserung der Bedienbarkeit.
Bei der Selektion von BC werden sämtliche Ausgabetexte zurückgesetzt auf den Wert Null.
In diesem Fall wird in den fertig-Modus gewechselt.
Sind alle diese Fallunterscheidungen abgearbeitet, so ist im Falle fertig die Schleife zu verlassen. Einzige Ausnahme bilden dabei nur die vier Feldtasten: BC, BMOD, BINV und BVZW, bei denen in der Schleife verblieben wird. Hier liegt lediglich eine Statusänderung vor, die erst nach Eingabe eines Kommandos berücksichtigt werden muß.
Außerhalb der zentralen REPEAT-Schleife ist nur noch darauf zu achten, daß der Operator und der Operand mit den beiden dafür zuständigen Funktionen besorgt werden. Die Variable gueltig wurde bereits innerhalb der Schleife laufend korrigiert. Glücklicherweise haben wir es damit endlich geschafft. Unsere Schnittstelle ist mit den entsprechenden Parametern versorgt worden und wir können uns auf die nächste Folge vertagen.
Abgedruckt finden Sie allerdings auch noch den Rest von do_rechner (Zeilen 501-893) und die Resource-Umgebung des Rechners (Listing 15). Wie bereits eingangs angekündigt, werden diese Bestandteile jedoch erst beim nächsten Mal näher erläutert. Es geht dabei im wesentlichen um die Abarbeitung der heute erhaltenen Wert-/Operatorsequenzen. Weiterer Programmpunkt der nächsten und letzten (!) Folge des Lovely Helpers ist das (lange ersehnte) Zusammenbinden der bisher erhaltenen einzelnen Bestandteile zu dem kompletten Accessory. Ich hoffe, Ihre Geduld reicht noch für einen Monat aus. Bis dahin!
D. Brockhaus
(* resource set indicies for RECHNER *)
CONST
rechner = 0; (* form/dialog *)
tmant = 2; (* TEXT in tree RECHNER *)
texpexp = 3; (* TEXT in tree RECHNER *)
tvz = 4; (* TEXT in tree RECHNER *)
texpvz = 5; (* TEXT in tree RECHNER *)
texptext = 6; (* TEXT in tree RECHNER *)
tinv = 7; (* TEXT in tree RECHNER *)
tm = 8; (* TEXT in tree RECHNER *)
tdeg = 9; (* TEXT in tree RECHNER *)
trad = 10; (* TEXT in tree RECHNER *)
tgrad = 11; (* TEXT in tree RECHNER *)
bsieben = 14; (* BUTTON in tree RECHNER *)
bacht = 15; (* BUTTON in tree RECHNER *)
bneun = 16; (* BUTTON in tree RECHNER *)
be = 17; (* BUTTON in tree RECHNER *)
bac = 18; (* BUTTON in tree RECHNER *)
bmin = 19; (* BUTTON in tree RECHNER *)
bmr = 20; (* BUTTON in tree RECHNER *)
bmminus = 21; (* BUTTON in tree RECHNER *)
bmplus = 22; (* BUTTON in tree RECHNER *)
bvier = 23; (* BUTTON in tree RECHNER *)
bfuenf = 24; (* BUTTON in tree RECHNER *)
bsechs = 25; (* BUTTON in tree RECHNER *)
bmal = 26; (* BUTTON in tree RECHNER *)
bdurch = 27; (* BUTTON in tree RECHNER *)
binv = 28; (* BUTTON in tree RECHNER *)
bsin = 29; (* BUTTON in tree RECHNER *)
bcos = 30; (* BUTTON in tree RECHNER *)
btan = 31; (* BUTTON in tree RECHNER *)
beins = 32; (* BUTTON in tree RECHNER *)
bzwei = 33; (* BUTTON in tree RECHNER *)
bdrei = 34; (* BUTTON in tree RECHNER *)
bplus = 35; (* BUTTON in tree RECHNER *)
bminus = 36; (* BUTTON in tree RECHNER *)
bmod = 37; (* BUTTON in tree RECHNER *)
bquadrat = 38; (* BUTTON in tree RECHNER *)
bln = 39; (* BUTTON in tree RECHNER *)
blog = 40; (* BUTTON in tree RECHNER *)
bnull = 41; (* BUTTON in tree RECHNER *)
bkomma = 42; (* BUTTON in tree RECHNER *)
bexp = 43; (* BUTTON in tree RECHNER *)
bgleich = 44; (* BUTTON in tree RECHNER *)
bvzw = 45; (* BUTTON in tree RECHNER *)
bklauf = 46; (* BUTTON in tree RECHNER *)
bklzu = 47; (* BUTTON in tree RECHNER *)
bend = 48; (* BUTTON in tree RECHNER *)
{************************************************************}
{* Listing 14 : Ein naturwissenschaftlicher Taschenrechner *}
{* (c) MAXON Computer GmbH *}
{* Datei : RECHNER1.PAS *}
{* last update : 19.5.1988 *}
{************************************************************}
PROCEDURE do_rechner;
CONST leerer_stack = 0;
max_op_stack = 60;
max_real_stack = 50;
pi = 3.1415926;
deg = 0;
rad = 1;
grad = 2;
an = 0;
aus = 1;
TYPE op_type = (f_klammer_auf, f_klammer_zu, f_gleich,
f_ac, f_end, f_min, f_mr, f_mminus, f_mplus,
f_mult, f_div, f_add, f_sub,
f_sin, f_cos, f_tan, f_inv_sin, f_inv_cos,
f_inv_tan, f_quadrat, f_wurzel, f_ln, f_log,
f_exp, f_exp10);
real_stack = RECORD
element :
ARRAY [1..max_real_stack] OF real;
ptr : integer;
END;
op_stack = RECORD
element :
ARRAY [1..max_op_stack] OF op_type;
ptr : integer;
END;
VAR stack_op : op_stack;
operator : op_type;
stack_val : real_stack;
value : real;
error ,
inv_modus ,
tri_modus : integer;
t_faktor ,
speicher : real;
first_rechner ,
gueltig : boolean;
mant_vz ,
mant_wert ,
exp_text ,
exp_vz ,
exp_wert ,
inv_text ,
mem_text ,
deg_text ,
rad_text ,
gra_text : str255;
PROCEDURE setze_texte;
VAR str : str255;
i : integer;
BEGIN
set_dtext(rechner_dialog,tvz,mant_vz, system_font,te_left);
str:=mant_wert;
WHILE length(str)<8 DO
str:=concat(str,' ');
set_dtext(rechner_dialog,traant,str,system_font,te_left);
set_dtext(rechner_dialog,texpvz,exp_vz,small_font,te_left);
set_dtext(rechner_dialog,texpexp,exp_wert,small_font,te_left);
set_dtext(rechner_dialog,texptext,exp_text,system_font,te_left);
set_dtext(rechner_dialog,tinv,inv_text,small_font,te_left);
set_dtext(rechner_dialog,tm,mem_text,small_font,te_left);
set_dtext(rechner_dialog,tdeg,deg_text,small_font,te_left);
set_dtext(rechner_dialog,trad,rad_text,small_font,te_left);
set_dtext(rechner_dialog,tgrad,gra_text,small_font,te_left);
END;
PROCEDURE setze_redraw;
BEGIN
obj_redraw(rechner_dialog,tvz);
obj_redraw(rechner_dialog,tmant);
obj_redraw(rechner_dialog,texpvz);
obj_redraw(rechner_dialog,texpexp);
obj_redraw(rechner_dialog,texptext);
obj_redraw(rechner_dialog,tinv);
obj_redraw(rechner_dialog,tm);
obj_redraw(rechner_dialog,tdeg);
obj_redraw(rechner_dialog,trad);
obj_redraw(rechner_dialog,tgrad);
END;
PROCEDURE do_error;
VAR button : integer;
BEGIN
CASE error OF
1 : mant_wert:='Error A';
2 : mant_wert:='Error O';
3 : mant_wert:='Error U';
4 : mant_wert:='Error ()';
5 : mant_wert:='Error M';
END;
mant_vz:=' ';
exp_vz:=' ' ;
exp_wert:=' ';
exp_text:=' ';
inv_text:=' ';
setze_texte;
IF first_rechner THEN
BEGIN
button:=do_dialog(rechner_dialog,0);
obj_setstate(rechner_dialog,button, normal,true);
first_rechner:=false;
END
ELSE
BEGIN
setze_redraw;
button:=redo_dialog(rechner_dialog,0);
obj_setstate(rechner_dialog,button,normal,true);
END;
END;
PROCEDURE do_edit(VAR zahl : real;
VAR operator : op_type);
CONST fertig = 0;
vorkomma = 1;
nachkomma = 2;
exponent = 3;
VAR status ,
button : integer;
PROCEDURE setze_zahl(zahl : real);
VAR help : long_integer;
i : integer;
PROCEDURE exp_darstellung;
VAR log_help ,
mant_real : real;
i ,
exp_int : integer;
BEGIN
log_help:=log(zahl);
exp_int:=trunc(log_help);
mant_real:=exp10(log_help-exp_int);
mant_wert:=' ';
mant_wert[1]:=charakter(trunc(mant_real));
mant_real:=mant_real-trunc(mant_real);
FOR i:=3 TO 8 DO
BEGIN
mant_real:=mant_real*10;
mant_wert[i]:=charakter(trunc(mant_real));
mant_real:=mant_real-trunc(mant_real);
END;
exp_wert:=' ';
exp_text:=' ';
exp_vz:=' ';
IF exp_int<>0 THEN
IF abs(exp_int)=38 THEN
BEGIN
IF exp_int<0 THEN
exp_vz:='-';
mant_wert:='9.999999';
exp_wert:='37';
exp_text:='E';
END
ELSE
BEGIN
IF exp_int<0 THEN
exp_vz:='-';
exp_int:=abs(exp_int);
exp_wert[1]:=charakter(exp_int DIV 10);
exp_wert[2]:=charakter(exp_int MOD 10);
exp_text:='E';
END;
END;
BEGIN
IF zahl>=0 THEN
mant_vz:=' '
ELSE
mant_vz:='-';
zahl:=abs(zahl);
IF zahl<9999999 THEN
IF zahl=long_trunc(zahl) THEN
BEGIN
help:=long_trunc(zahl);
mant_wert:=' 0. ';
FOR i:= 7 DOWNTO 1 DO
IF help>0 THEN
BEGIN
mant_wert[i]:=charakter (help MOD 10);
help:=help DIV 10;
END;
WHILE mant_wert[1]=' ' DO
BEGIN
delete(mant_wert,1,1);
insert(' ',mant_wert,8);
END;
exp_vz:=' ';
exp_wert:=' ';
exp_text:=' ';
END
ELSE
exp_darstellung
ELSE
exp_darstellung;
deg_text:=' ';
rad_text:=' ';
gra_text:=' ';
CASE tri_modus OF
deg : deg_text: = * DEG';
rad : rad_text:='RAD';
grad : gra_text:='GRAD';
END;
IF inv_modus=an THEN
inv_text:='INV'
ELSE
inv_text:=' ';'
IF speicher=0 THEN
mem_text:=' '
ELSE
mem_text:='M';
END;
FUNCTION rsc_char : char;
BEGIN
CASE button OF
bnull : rsc_char:='0';
beins : rsc_char:='1';
bzwei : rsc_char:='2';
bdrei : rsc_char:='3';
bvier : rsc_char:='4';
bfuenf : rsc_char:='5';
bsechs : rsc_char:='6';
bsieben : rsc_char:='7';
bacht : rsc_char:='8';
bneun : rsc_char:='9';
END;
END;
FUNCTION get_operator : op_type;
BEGIN
CASE button OF
bgleich : get_operator:=f_gleich;
bmal : get_operator:=f_mult;
bdurch : get_operator:=f_div;
bplus : get_operator:=f_add;
bminus : get_operator:=f_sub;
bac : get_operator:=f_ac;
bklauf : get_operator:=f_klammer_auf;
bklzu : get_operator:=f_klammer_zu;
bend : get_operator:=f_end;
bmin : get_operator:=f_min;
bmr : get_operator:=f_mr;
bmminus : get_operator:=f_mminus;
bmplus : get_operator:=f_mplus;
bsin : IF inv_modus=aus THEN
get_operator:=f_sin
ELSE
get_operator:=f_inv_sin;
bcos : IF inv_modus=aus THEN
get_operator:=f_cos
ELSE
get_operator:=f_inv_cos;
btan : IF inv_modus=aus THEN
get_operator:=f_tan
ELSE
get_operator:=f_inv_tan;
bquadrat: IF inv_modus=aus THEN
get_operator:=f_quadrat
ELSE
get_operator:=f_wurzel;
bln : IF inv_modus=aus THEN
get_operator:=f_ln
ELSE
get_operator:=f_exp;
blog : IF inv_modus=aus THEN
get_operator:=f_log
ELSE
get_operator:=f_exp10;
END;
inv_modus:=aus;
END;
FUNCTION get_zahl : real;
VAR vor ,
nach ,
mant ,
expo ,
d_fak : real;
str : str255;
BEGIN
mant:=0;
vor:=0;
nach:=0;
expo:=0;
d_fak:=1;
str:=mant_wert;
WHILE (str[1]<>'.') AND (length(str)>0) DO
BEGIN
IF str[1] in ['O'..'9') THEN vor:=vor*10+digit(str[1]); delete(str,1,1);
END;
WHILE length(str)>0 DO
BEGIN
IF str[1] in ['0'..'9'] THEN
BEGIN
nach:=10*nach+digit(str[1]);
d_fak:=d_fak*10;
END;
delete(str,1,1);
END;
mant:=vor+nach/d_fak;
IF mant_vz='-' THEN
mant:=-mant;
expo:=0;
str:=exp_wert;
WHILE length(str)>0 DO
BEGIN
IF str[1] in ['O'..'9'] THEN
expo:=10*expo+digit(str[1]);
delete(str,1,1);
END;
IF exp_vz='-' THEN
expo:=-expo;
IF (expo>0) AND (trunc(log(abs(mant)+1e-31)+1)+abs(expo)>38) THEN
error:=1
ELSE
get_zahl:=mant*exp10(expo);
END;
BEGIN
gueltig:=false;
status:=fertig;
setze_zahl(zahl);
REPEAT
IF first_rechner THEN
BEGIN
setze_texte;
first_rechner:=false;
button:=do_dialog(rechner_dialog,0);
obj_setstate(rechner_dialog,button,normal,true);
END
ELSE
BEGIN
setze_texte;
setze_redraw;
button:=redo_dialog(rechner_dialog,0);
obj_setstate(rechner_dialog,button,normal,true);
END;
CASE button OF
bmod : BEGIN
tri_modus:=(tri_modus+1) MOD3;
deg_text:=' ';
rad_text:=' ';
gra_text:=' ';
CASE tri_modus OF
deg : BEGIN
t_faktor:=pi180;
deg_text:='DEG';
END;
rad : BEGIN
t_faktor:=1;
rad_text:='RAD';
END;
grad: BEGIN
t_faktor:=pi/200;
gra_text:='GRAD';
END;
END;
END;
binv : BEGIN
inv_modus:=(inv_raodus+1)MOD2;
IF inv_modus=an THEN
inv_text:='INV'
ELSE
inv_text:=' ';
END;
bnull ,
beins ,
bzwei ,
bdrei ,
bvier ,
bfuenf,
bsechs,
bsieben,
bacht ,
bneun : BEGIN
gueltig:=true;
CASE status OF
fertig : BEGIN
mant_wert:=' ';
mant_vz:=' ';
exp_text:=' ';
exp_wert:=' ';
exp_vz:=' ';
mant_wert[1]:=rsc_char;
status:=vorkomma;
END;
vorkomma :
IF length(mant_wert)<7 THEN
BEGIN
mant_wert:=concat(mant_wert,'');
mant_wert[length( mant_wert)]:=rsc_char;
END;
nachkomma :
IF length(mant_wert)<8 THEN
BEGIN
mant_wert:=concat(mant_wert,' ');
mant_wert[length(mant_wert)]:=rsc_char;
END;
exponent :
IF exp_wert=' ' THEN
exp_wert[1]:=rsc_char
ELSE
exp_wert[2]:=rsc_char;
END;
END;
bkomma : IF (status=vorkomma) AND (length(mant_wert)<7) THEN
BEGIN
gueltig:=true;
status:=nachkomma;
mant_wert:=concat(mant_wert,'.');
END
ELSE
IF status=fertig THEN
BEGIN
gueltig:=true;
exp_text:=' ';
exp_vz:=' ';
exp_wert:=' ';
status:=nachkomma;
mant_wert:='0.';
END;
bvzw : BEGIN
gueltig:=true;
CASE status OF
fertig ,
vorkomma ,
nachkomma : IF mant_vz=' ' THEN
mant_vz:='-'
ELSE
mant_vz:=' ';
exponent : IF exp_vz=' ' THEN
exp_vz:='-'
ELSE
exp_vz:=' ';
END;
END;
bexp: BEGIN
gueltig:=true;
exp_text:='E';
exp_vz:=' ';
exp_wert:=' ';
IF status=fertig THEN
BEGIN
mant_vz:=' ';
mant_wert:='1';
END;
status:=exponent;
END;
bc : BEGIN
gueltig:=true;
mant_wert:='0. ';
mant_vz:=' ';
exp_wert:=' ';
exp_vz:=' ';
exp_text:=' ';
status:=fertig;
END;
OTHERWISE: status:=fertig;
END;
UNTIL (status=fertig) AND (button<>bc) AND (button<>bmod) AND (button<>binv) AND (button<>bvzw);
operator:=get_operator;
zahl:=get_zahl;
END;
PROCEDURE create_op(VAR x : op_stack);
BEGIN
x.ptr:=leerer_stack;
END;
FUNCTION is_empty_op(x : op_stack) : boolean;
BEGIN
is_empty_op:=x.ptr=leerer_stack;
END;
FUNCTION pop_op(VAR x : op_stack) : boolean;
VAR help : boolean;
BEGIN
help:=NOT is_empty_op(x);
IF help THEN
x.ptr:=x.ptr-1;
pop_op:=help;
END;
FUNCTION push_op(VAR x : op_stack;
a : op_type) : boolean;
VAR help : boolean;
BEGIN
WITH x DO
BEGIN
help:=ptr<max_op_stack;
IF help THEN
BEGIN
ptr:=ptr+1;
element[ptr]:=a;
END;
END;
push_op:=help;
END;
FUNCTION top_op(x : op_stack) : op_type;
BEGIN
IF NOT is_empty_op(x) THEN
top_op:=x.element[x.ptr];
END;
FUNCTION anz_grund_op(x : op_stack) : integer;
VAR count ,
i : integer;
BEGIN
count:=0;
FOR i:=1 TO x.ptr DO
IF x.element[i] in [f_add,f_sub,f_div,f_mult] THEN
count:=count+1;
anz_grund_op:=count;
END;
PROCEDURE create_real(VAR x : real_stack);
BEGIN
x.ptr:=leerer_stack;
END;
FUNCTION is_empty_real(x: real_stack): boolean;
BEGIN
is_empty_real:=x.ptr=leerer_stack;
END;
FUNCTION push_real(VAR x : real_stack;
a : real) : boolean;
VAR help : boolean;
BEGIN
WITH x DO
BEGIN
help:=ptr<max_real_stack;
IF help THEN
BEGIN
ptr:=ptr+1;
element[ptr]:=a;
END;
END;
push_real:=help;
END;
FUNCTION pop_real(VAR x : real_stack): boolean;
VAR help : boolean;
BEGIN
help:=NOT is_empty_real(x);
IF help THEN
x.ptr:=x.ptr-1;
pop_real:=help;
END;
FUNCTION top_real(x : real_stack) : real;
BEGIN
IF NOT is_empty_real(x) THEN
top_real:=x.element[x.ptr];
END;
FUNCTION depth_real(VAR x:real_stack): integer;
BEGIN
depth_real:=x.ptr;
END;
PROCEDURE reset_rechner;
BEGIN
inv_modus:=aus;
tri_modus:=deg;
t_faktor:=pi/180;
create_op(stack_op);
create_real(stack_val);
operator:=f_gleich;
END;
FUNCTION prior(operator : op_type) : integer;
BEGIN
CASE operator OF
f_klammer_auf : prior:=0;
f_add ,
f_sub : prior:=1;
f_div ,
f_mult : prior:=2;
END;
END;
PROCEDURE do_operator;
VAR operator : op_type;
zahl1 ,
zahl2 : real;
FUNCTION anz_operanden(operator : op_type) : integer;
BEGIN
CASE operator OF
f_mult ,
f_div ,
f_add ,
f_sub : anz_operanden:=2;
OTHERWISE : anz_operanden:=1;
END;
END;
FUNCTION vorz_plus(op1 , op2 : real) : boolean;
VAR vorz : integer;
BEGIN
vorz:=1;
IF op1<0 THEN
vorz:=-1;
IF op2<0 THEN
vorz:=-vorz;
vorz_plus:=vorz=1;
END;
BEGIN
operator:=top_op(stack_op);
IF NOT pop_op(stack_op) THEN
error:=4;
IF anz_operanden(operator)=2 THEN
BEGIN
zahl2:=top_real(stack_val);
IF NOT pop_real(stack_val) THEN
error:=4;
zahl1:=top_real(stack_val);
IF NOT pop_real(stack_val) THEN
error:=4;
END
ELSE
BEGIN
zahl1:=top_real(stack_val);
IF NOT pop_real(stack_val) THEN
error:=4;
END;
IF error=0 THEN
CASE operator OF
f_log : IF zahl1>0 THEN
zahl1:=log(zahl1)
ELSE
error:=3;
f_exp10 : IF zahl1<38 THEN
zahl1:=exp10(zahl1)
ELSE
error:=1;
f_ln : IF zahl1>0 THEN
zahl1:=ln(zahl1)
ELSE
error:=3;
f_exp : IF zahl1<=87.49823 THEN
zahl1:=exp(zahl1)
ELSE
error:=1;
f_sin : IF abs(zahl1*t_faktor)<=30 THEN
zahl1:=sin(zahl1*t_faktor)
ELSE
error:=1;
f_inv_sin : IF abs(zahl1)<=1 THEN
IF abs(zahl1)=1 THEN
zahl1:=zahl1*pi/2/t_faktor
ELSE
zahl1:=arctan(zahl1/sqrt(-zahl1*zahl1+1))/t_faktor
ELSE
error:=3;
f_cos : IF abs(zahl1*t_faktor)<=30 THEN
zahl1:=cos(zahl1*t_faktor)
ELSE
error:=1;
f_inv_cos : IF abs(zahl1)<=1 THEN
IF abs(zahl1)=1 THEN
zahl1:=(1-zahl1)*pi/2/t_faktor
ELSE
zahl1:=(pi/2-arctan(zahl1/sqrt(-zahl1* zahl1+1)))/t_faktor
ELSE
error:=3;
f_tan : IF abs(zahl1*t_faktor)<=30 THEN
IF cos(zahl1*t_faktor)<>0 THEN
zahl1:=sin(zahl1*t_faktor)/cos(zahl1*t_faktor)
ELSE
error:=3
ELSE
error:=1;
f_inv_tan : zahl1:=arctan(zahl1)/t_faktor;
f_quadrat : IF abs(zahl1)<=9.999999e18 THEN
zahl1:=sqr(zahl1)
ELSE
error:=1;
f_wurzel : IF zahl1>0 THEN
zahl1:=sqrt(zahl1)
ELSE
error:=3;
f_min : speicher:=zahl1;
f_mr : zahl1:=speicher;
f_mminus : IF ((abs(speicher)<=4.999999e37) AND (abs(zahl1)<=4.999999e37)) OR vorz_plus(speicher,zahl1) THEN
speicher:=speicher-zahl1
ELSE
error:=5;
f_mplus : IF ((abs(speicher)<=4.999999e37) AND (abs(zahl1)<4.999999e37)) OR NOT vorz_plus(speicher,zahl1) THEN
speicher:=speicher+zahl1
ELSE
error:=5;
f_add : IF ((abs(zahl1)<=4.999999e37) AND (abs(zahl2)<=4.999999e37)) OR NOT vorz_plus(zahl1,zahl2) THEN
zahl1:=zahl1+zahl2
ELSE
error:=1;
f_sub : IF ((abs(zahl1)<=4.999999e37) AND (abs(zahl2)<=4.999999e37)) OR vorz_plus(zahl1,zahl2) THEN
zahl1:=zahl1-zahl2
ELSE
error:=1;
f_mult : IF (zahl<1) OR (zahl2<1) OR (log(abs(zahl1)+1e-7)+log(abs(zahl2)+1e-7)<38) THEN
zahl1:=zahl1*zahl2
ELSE
error:=1;
f_div : IF zahl2<>0 THEN
IF (zahl<1) OR (zahl2>1) OR (log(abs(zahl1)+1e-7)-log(abs(zahl2))<38) THEN
zahl1:=zahl1/zahl2
ELSE
error:=1
ELSE
error:=2;
END;
IF NOT push_real(stack_val,zahl1) THEN
error:=4;
END;
BEGIN
first_rechner:=true;
speicher:=0;
value:=0;
reset_rechner;
begin_update;
REPEAT
error:=0;
do_edit(value,operator);
IF is_empty_op(stack_op) THEN
BEGIN
create_real(stack_val);
IF push_real(stack_val,value) THEN
;
END
ELSE
IF gueltig THEN
BEGIN
IF NOT push_real(stack_val,value) THEN
error:=4;
END
ELSE
IF (operator<>f_klammer_auf) AND (anz_grund_op(stack_op)=depth_real(stack_val)) THEN
BEGIN
IF NOT push_real(stack_val,top_real(stack_val)) THEN
error:=4;
END;
IF error=0 THEN
CASE operator OF
f_min ,
f_mr ,
f_mminus ,
f_mplus ,
f_sin ,
f_cos ,
f_tan ,
f_inv_sin ,
f_inv_cos ,
f_inv_tan ,
f_quadrat ,
f_wurzel ,
f_ln ,
f_log ,
f_exp ,
f_exp10 : IF NOT push_op(stack_op, operator) THEN
error:=4
ELSE
do_operator;
f_mult , f_div ,
f_add ,
f_sub : BEGIN
WHILE (prior(top_op(stack_op))>=prior(operator)) AND NOT is_empty_op(stack_op) AND (error=0) DO
do_operator;
IF NOT push_op(stack_op, operator) THEN
error:=4;
END;
f_klammer_auf :
IF NOT gueltig THEN
IF NOT push_op(stack_op,operator) THEN
error:= 4;
f_klammer_zu:
BEGIN
WHILE (top_op(stack_op)<>f_klammer_auf) AND NOT is_empty_op(stack_op) AND (error=0) DO
do_operator;
IF top_op(stack_op)= f_klammer_auf THEN
IF NOT pop_op(stack_op) THEN
error:=4;
END;
f_gleich : BEGIN
WHILE NOT is_empty_op(stack_op) DO
do_operator;
value:=top_real(stack_val);
reset_rechner;
IF NOT push_real(stack_val,value) THEN
;
END;
f_ac : reset_rechner;
END;
IF error<>0 THEN
BEGIN
do_error;
reset_rechner;
error:=0;
END;
IF is_empty_real(stack_val) THEN
value:=0
ELSE
value:=top_real(stack_val);
UNTIL operator=f_end;
end_dialog(rechner_dialog);
end_update;
END;
{***********************************************************}
{* Listing 15 : Resource-Handling für den Taschenrechner *}
{* (c) MAXON Computer GmbH *}
{* Datei : RECHNER.PAS *}
{* last update : 19.5.1988 *}
{***********************************************************}
{$s10}
PROGRAM rechner (input,output);
CONST {$i gemconst.pas}
{$i trixcons.pas}
{$i rechner.i}
TYPE {$i gemtype.pas}
{$i trixtype.pas}
VAR msg : message_buffer;
apl_name : str255;
apl_nr ,
menu_nr ,
event ,
dummy : integer;
rechner_dialog : dialog_ptr;
{$i gemsubs.pas}
{$i trixsubs.pas}
{$i hilf.pas)
{$i rechner1.pas}
FUNCTION initialisieren : boolean;
VAR ok : boolean;
BEGIN
ok:=load_resource('A:\RECHNER.RSC');
IF ok THEN
BEGIN
apl_name:=' Taschenrechner';
menu_nr:=menu_register(apl_nr,apl_name);
find_dialog(rechner,rechner_dialog);
center_dialog(rechner_dialog);
END;
initialisieren:=ok;
END;
BEGIN
apl_nr:=init_gem;
IF apl_nr>=0 THEN
IF initialisieren THEN
WHILE true DO
BEGIN
event:=get_event(e_message,0,0,0,0,true,
0,0,0,0,true,0,0,0,0,msg,dummy,dummy,dummy,
dummy,dummy,dummy);
IF msg[0]=ac_open THEN
do_rechner;
END;
END.