summaryrefslogtreecommitdiff
path: root/app/tecal
diff options
context:
space:
mode:
Diffstat (limited to 'app/tecal')
-rw-r--r--app/tecal/1.8.7/source-disk1
-rw-r--r--app/tecal/1.8.7/src/TeCal856
-rw-r--r--app/tecal/1.8.7/src/TeCal Auskunftbin0 -> 45056 bytes
-rw-r--r--app/tecal/1.8.7/src/TeCal.gen55
4 files changed, 912 insertions, 0 deletions
diff --git a/app/tecal/1.8.7/source-disk b/app/tecal/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/app/tecal/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/app/tecal/1.8.7/src/TeCal b/app/tecal/1.8.7/src/TeCal
new file mode 100644
index 0000000..0bcb18e
--- /dev/null
+++ b/app/tecal/1.8.7/src/TeCal
@@ -0,0 +1,856 @@
+(**********************************************************************)
+(* *)
+(* TeCal - Text Calculator *)
+(* *)
+(* Autor : Andreas Schmeink 06.09.1984 *)
+(* Korrektur: Hilmar v.d. Bussche 17.09.1984 *)
+(* 20.09.1984 *)
+(* Adaption : Uwe Behrend, Andreas Schmeink 03.08.1987 *)
+(**********************************************************************)
+
+PACKET pick DEFINES pick up number, left range, right range,
+ replace number, last pick up ok :
+
+(********************************************************************)
+(* *)
+(* Zahlen erkennen und schreiben für TeCal 12.09.84 *)
+(* *)
+(********************************************************************)
+
+LET ziffern = "0123456789", pseudoblankcode = 223;
+
+ROW 10 REAL VAR ziffer plus eins
+ := ROW 10 REAL : (0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0);
+REAL VAR number;
+BOOL VAR ziffer gefunden;
+INT VAR anfang, ende, zeichencode, vorkommastellen, p, dezimalzeichen;
+TEXT VAR worktext;
+
+BOOL PROC last pick up ok:
+ ziffer gefunden
+END PROC last pick up ok;
+
+REAL PROC code to digit (INT CONST code) :
+ ziffer plus eins (code-47)
+END PROC code to digit;
+
+INT PROC left range :
+ anfang
+END PROC left range;
+
+INT PROC right range :
+ ende
+END PROC right range;
+
+REAL PROC pick up number (TEXT CONST source, INT CONST where) :
+
+ suche ende der zahl;
+ lies zahl ein;
+ number.
+
+suche ende der zahl :
+ fange bei gegebener position an;
+ IF vorzeichen THEN
+ nach rechts ruecken
+ FI;
+ WHILE erlaubtes zeichen REP
+ nach rechts ruecken
+ PER;
+ ende merken.
+
+fange bei gegebener position an:
+ ziffer gefunden := FALSE;
+ p := where;
+ betrachte aktuelles zeichen.
+
+nach rechts ruecken:
+ p INCR 1;
+ betrachte aktuelles zeichen.
+
+nach links ruecken:
+ p DECR 1;
+ betrachte aktuelles zeichen.
+
+ende merken :
+ ende := p - 1.
+
+lies zahl ein :
+ fange hinter der zahl an;
+ sammle ziffern auf;
+ pruefe vorzeichen;
+ werte exponent aus.
+
+sammle ziffern auf :
+ REP
+ nach links ruecken;
+ IF ziffer THEN
+ ziffer behandeln
+ ELIF punkt OR komma THEN
+ IF wirkt als dezimalzeichen THEN
+ dezimalzeichen behandeln
+ ELSE ignorieren
+ FI
+ ELIF pseudoblank vor ziffer THEN
+ ignorieren
+ ELSE
+ LEAVE sammle ziffern auf
+ FI;
+ PER.
+
+pruefe vorzeichen :
+ IF minus THEN
+ anfang := p;
+ number := number * -1.0
+ ELIF plus THEN
+ anfang := p
+ ELSE
+ anfang := p+1
+ FI.
+
+werte exponent aus :
+ set exp (vorkommastellen+decimal exponent(number), number).
+
+fange hinter der zahl an :
+ vorkommastellen := 0;
+ dezimalzeichen := 0;
+ number := 0.0;
+ p := ende + 1.
+
+betrachte aktuelles zeichen:
+ zeichencode := code (source SUB p).
+
+ziffer behandeln :
+ ziffer gefunden := TRUE;
+ number := (number + code to digit (zeichencode))/10.0;
+ vorkommastellen INCR 1.
+
+dezimalzeichen behandeln :
+ dezimalzeichen := zeichencode;
+ vorkommastellen := 0.
+
+wirkt als dezimalzeichen :
+ dezimalzeichen = 0 OR dezimalzeichen = zeichencode.
+
+erlaubtes zeichen :
+ ziffer OR punkt OR komma OR pseudoblank vor ziffer.
+
+pseudoblank vor ziffer :
+ zeichencode = pseudoblankcode AND pos (ziffern, source SUB (p+1) ) > 0.
+
+vorzeichen : plus OR minus.
+
+ziffer : zeichencode >= 48 AND zeichencode <= 57.
+
+plus : zeichencode = 43.
+
+minus : zeichencode = 45.
+
+punkt : zeichencode = 46.
+
+komma : zeichencode = 44.
+
+ignorieren :.
+
+END PROC pick up number;
+
+PROC replace number (TEXT VAR source, REAL CONST value, INT CONST where,
+ nachkommastellen) :
+
+ alte grenzen feststellen;
+ wenn noetig auf format der neuen zahl erweitern;
+ zahl in text umwandeln;
+ zahl ersetzen.
+
+alte grenzen feststellen :
+ REAL VAR dummy;
+ dummy := pick up number (source, where).
+
+wenn noetig auf format der neuen zahl erweitern :
+ INT VAR schreibanfang := min (anfang, neuer anfang),
+ schreibende := max (ende, neues ende).
+
+neuer anfang : where - vorkommazeichen + 1.
+
+vorkommazeichen : max (2,(decimal exponent (value) + 2)).
+
+neues ende : where + nachkommastellen + 1.
+
+zahl in text umwandeln :
+ worktext := text (value,stellen,nachkommastellen);
+ IF decimal exponent (value) < 0 THEN
+ change (worktext," .","0."); change (worktext," -.","-0.");
+ FI;
+ IF nachkommastellen = 0 THEN
+ replace (worktext, LENGTH worktext, " ")
+ FI;
+ WHILE LENGTH worktext < schreibende-schreibanfang+1 REP
+ worktext CAT " "
+ PER.
+
+zahl ersetzen :
+ WHILE LENGTH source < schreibende REP
+ source CAT " "
+ PER;
+ replace (source, schreibanfang, worktext) .
+
+stellen : where-schreibanfang+2+nachkommastellen.
+
+END PROC replace number;
+
+END PACKET pick;
+
+PACKET rechner DEFINES clear, push, result, do,
+ superklammer auf, superklammer zu,
+ empty, operand expected, dump:
+
+(********************************************************************)
+(* *)
+(* Rechenwerk fuer TeCal 13.09.84 *)
+(* *)
+(********************************************************************)
+
+LET plus = 1, minus = 2, mal = 3, durch = 4, hoch = 5,
+ monad minus = 6, klammer auf = 7, klammer zu = 8, gleich = 9;
+
+LET klammerpriostufe = 10, superklammerpriostufe = 500;
+
+LET tiefe = 30;
+
+REAL VAR dummy;
+BOOL VAR war operand;
+
+INT VAR operandentop, operatorentop, klammerprio, superklammerprio;
+
+ROW tiefe INT VAR operatorenstack;
+ROW tiefe REAL VAR operandenstack;
+
+PROC superklammer auf :
+ IF war operand THEN
+ pop (dummy)
+ FI;
+ superklammerprio INCR superklammerpriostufe;
+ klammerprio INCR superklammerpriostufe
+END PROC superklammer auf;
+
+PROC superklammer zu :
+ IF superklammerprio > 0 THEN
+ push (gleich);
+ superklammerprio DECR superklammerpriostufe;
+ klammerprio DECR superklammerpriostufe
+ FI;
+END PROC superklammer zu;
+
+INT PROC prio (INT CONST op):
+ klammer prio + elementar prio.
+
+elementar prio :
+ SELECT op OF
+ CASE plus,minus : 2
+ CASE mal,durch : 3
+ CASE hoch : 4
+ CASE monadminus : 6
+ CASE klammerzu : 0
+ CASE gleich : -klammerprio+superklammerprio
+ OTHERWISE errorstop ("prio("+text(op)+")"); 0
+ END SELECT
+END PROC prio;
+
+PROC clear :
+ operandentop := 0;
+ operatorentop := 0;
+ war operand := FALSE;
+ klammerprio := 0;
+ superklammerprio := 0;
+END PROC clear;
+
+PROC push (INT CONST op) :
+ enable stop;
+ IF war operand THEN
+ dyadischer operator oder gleich oder klammer zu
+ ELIF op = minus COR op = monad minus THEN
+ push monadisches minus
+ ELIF op = plus THEN
+ (* ignoriere monad plus *)
+ ELIF op = klammer auf THEN
+ IF stack zu voll THEN
+ errorstop ("Zuviele offene Klammern")
+ FI;
+ klammerprio INCR klammerpriostufe
+ ELSE
+ errorstop ("Zahl erwartet, letzten Operator ignoriert")
+ FI.
+
+dyadischer operator oder gleich oder klammer zu :
+ IF op = monad minus COR op = klammer auf THEN
+ (* errorstop ("Operator (+,-,*,/) vor Klammer auf fehlt")*)
+ ignore last operand;
+ push (op);
+ LEAVE push
+ ELSE
+ WHILE prio (op) <= stack top prio REPEAT
+ auswerten
+ PER;
+ push operator
+ FI.
+
+stack top prio :
+ IF operatorentop = 0 THEN -1
+ ELSE operator DIV 10
+ FI.
+
+stack zu voll :
+ operandentop >= tiefe - 4.
+
+auswerten :
+ REAL VAR op2;
+ SELECT operator MOD 10 OF
+ CASE monad minus : operand := - operand
+ CASE plus : pop (op2); operand INCR op2
+ CASE minus: pop (op2); operand DECR op2
+ CASE mal : pop (op2); operand := operand * op2
+ CASE durch: pop (op2); operand := operand / op2
+ CASE hoch : pop (op2); operand := operand ** op2
+ OTHERWISE
+(**) errorstop ("Im Opstack ("+text(operatorentop)+") gefunden : "+text(operator))
+ END SELECT;
+ war operand := TRUE;
+ operatorentop DECR 1.
+
+push operator :
+ IF op = klammerzu THEN
+ IF klammerprio > superklammerprio THEN
+ klammerprio DECR klammerpriostufe (* ELSE ignoriere ")" zuviel *)
+ FI
+ ELIF op = gleich THEN
+ klammerprio := superklammerprio;
+ ELSE
+ operatorentop INCR 1;
+ operator := prio (op) * 10 + op;
+ war operand := FALSE
+ FI.
+
+push monadisches minus :
+ operatorentop INCR 1;
+ operator := prio (monad minus) * 10 + monad minus.
+
+ignore last operand :
+ pop (dummy).
+
+END PROC push;
+
+PROC push (REAL CONST op) :
+ IF war operand THEN
+ operand := op; (* Operand wird ueberschrieben *)
+ ELSE
+ operandentop INCR 1;
+ operand := op;
+ war operand := TRUE
+ FI
+END PROC push;
+
+PROC pop (REAL VAR r) :
+ IF operandentop = 0 THEN
+ errorstop ("Operand fehlt")
+ ELSE r := operand;
+ operandentop DECR 1
+ FI;
+ war operand := FALSE
+END PROC pop;
+
+REAL PROC result :
+ IF operanden top > 0 THEN operand ELSE 0.0 FI
+END PROC result;
+
+BOOL PROC empty :
+ operandentop < 1
+END PROC empty;
+
+BOOL PROC operand expected :
+ NOT war operand
+END PROC operand expected;
+
+PROC do (REAL PROC (REAL CONST) f):
+ IF NOT war operand THEN
+ push (f(result))
+ ELSE
+ operand := f(operand)
+ FI
+END PROC do;
+
+PROC dump :
+ INT VAR x,y;
+ get cursor (x,y);
+ cursor (1,1);
+ INT VAR i;
+ put(operatorentop);put ("OPERATOREN");
+ FOR i FROM 1 UPTO operatorentop REP
+ put (text (operatorenstack(i),8));
+ PER;out (""5""); line;
+ put (operandentop);put ("OPERANDEN ");
+ FOR i FROM 1 UPTO operandentop REP
+ put (text (operandenstack(i),8,2));
+ PER;out (""5""); line;
+ put ("Klammern:");put(klammerprio);
+ put ("Superklammern:");put(superklammerprio);
+ IF war operand THEN put ("war operand") ELSE put ("war operator") FI;line;
+ cursor (x,y);
+END PROC dump;
+
+.
+operand : operandenstack (operandentop).
+operator: operatorenstack(operatorentop).
+
+END PACKET rechner;
+
+PACKET tecalfunctions DEFINES merke, prozentsatz, kommastellen,
+ prozent, evaluate, tecal :
+
+(********************************************************************)
+(* *)
+(* TeCal - Funktionen 15.09.84 *)
+(* *)
+(********************************************************************)
+
+LET operatorenliste = "+-*/^ ()=", gib ausdruck = ""15" gib wert : ";
+
+REAL VAR speicher := 0.0, percent := 14.0, displayed value := -1.0;
+INT VAR nachkommastellen := 2;
+
+INT VAR zeiger,dachpos; (* fuer evaluate *)
+TEXT VAR char; (* fuer evaluate *)
+
+TEXT VAR status line, anzeigetext;
+INT VAR anzeigestart, anzeigelaenge, memorystart, prozentstart;
+init status line;
+
+PROC evaluate (TEXT CONST formel):
+ evaluate (formel,1)
+END PROC evaluate;
+
+PROC evaluate (TEXT CONST formel, INT CONST ab wo):
+ enable stop;
+ zum formelanfang;
+ REP
+ zum naechsten relevanten zeichen;
+ IF formelende THEN LEAVE evaluate
+ FI;
+ symbol verarbeiten
+ UNTIL gleich zeichen verarbeitet PER.
+
+zum formelanfang :
+ dachpos := pos (formel,"^");
+ zeiger:= ab wo - 1.
+
+zum naechsten relevanten zeichen :
+ REP
+ zum naechsten wahrscheinlich relevanten zeichen
+ UNTIL formelende COR wirklich relevant PER.
+
+zum naechsten wahrscheinlich relevanten zeichen:
+ zeiger := pos (formel,"%","=",zeiger+1);
+ IF dachpos <> 0 CAND zeiger > dachpos THEN
+ zeiger := dachpos;
+ dachpos := pos (formel,"^",dachpos+1)
+ FI.
+
+formelende :
+ zeiger = 0.
+
+wirklich relevant :
+ char := formel SUB zeiger;
+ pos ("',.:;<", char) = 0.
+
+symbol verarbeiten :
+ IF ziffer THEN
+ push (abs(pick up number(formel,zeiger)));
+ zeiger := right range
+ ELSE
+ INT VAR op := pos (operatorenliste,char);
+ IF op > 0 THEN
+ push (op)
+ ELIF char = "%" THEN
+ do (REAL PROC (REAL CONST) prozent)
+ ELSE errorstop ("TeCal FEHLER : symbol verarbeiten")
+ FI
+ FI.
+
+gleichzeichen verarbeitet : char = "=".
+
+ziffer : pos ("0123456789",char) > 0.
+
+END PROC evaluate;
+
+PROC merke (REAL CONST wert) :
+ speicher := wert;
+ set anzeigetext (speicher);
+ replace (statusline,memorystart,anzeigetext);
+ show status line
+END PROC merke;
+
+PROC merke (INT CONST wert) :
+ merke (real (wert));
+END PROC merke;
+
+PROC prozentsatz (REAL CONST wert) :
+ percent := wert;
+ replace (statusline,prozentstart,text(percent,6,2));
+ show status line;
+END PROC prozentsatz;
+
+PROC prozentsatz (INT CONST wert) :
+ prozentsatz (real (wert));
+END PROC prozentsatz;
+
+PROC kommastellen (INT CONST anz stellen) :
+ nachkommastellen := max ( 0, min (anz stellen, 16)) ;
+ set anzeigetext (0.0);
+ replace (statusline,anzeigestart,anzeigetext);
+ merke (speicher);
+END PROC kommastellen;
+
+REAL PROC prozent (REAL CONST wovon) :
+ percent * wovon / 100.0
+END PROC prozent;
+
+REAL PROC runden (REAL CONST was) :
+ round (was,nachkommastellen)
+END PROC runden;
+
+PROC init status line :
+ statusline :=
+"$Anzeige: & __________._________ $ %%%.%%% Memory: ----------.--------- &"
+; change all (statusline,"$",""15"");
+ change all (statusline,"&",""14"");
+ anzeigestart := pos (statusline,"_");
+ anzeigelaenge:= pos (statusline," ",anzeigestart)-anzeigestart;
+ memorystart := pos (statusline,"-");
+ prozentstart := pos (statusline,"%");
+ set anzeigetext (0.0);
+ replace (statusline,anzeigestart,anzeigetext);
+ set anzeigetext (speicher);
+ replace (statusline,memorystart,anzeigetext);
+ replace (statusline,prozentstart,text(percent,6,2))
+END PROC init status line;
+
+PROC show status line :
+ cursor (1,y screen size); out (statusline);
+ displayed value := 0.0;
+ display value
+END PROC show status line;
+
+PROC display value :
+ IF displayed value <> result THEN
+ cursor (anzeigestart,y screen size);
+ set anzeigetext (result);
+ out (anzeigetext)
+ FI.
+
+END PROC display value;
+
+PROC get expression (TEXT VAR exp) :
+ cursor (1,yscreen size);
+ out (gib ausdruck);
+ (x screen size - 4 - LENGTH gib ausdruck) TIMESOUT " ";
+ out (""14""15""8" ");
+ cursor (LENGTH gib ausdruck, y screen size);
+ editget (exp);
+END PROC get expression;
+
+PROC set anzeigetext (REAL CONST r) :
+ IF decimal exponent (r) + nachkommastellen + 3 <= anzeigelaenge THEN
+ anzeigetext := text (r,anzeigelaenge,nachkommastellen);
+ IF decimal exponent (r) < 0 THEN
+ change (anzeigetext," .","0."); change (anzeigetext," -.","-0.");
+ FI;
+ IF nachkommastellen = 0 THEN
+ replace (anzeigetext, LENGTH anzeigetext, " ")
+ FI;
+ ELSE
+ anzeigetext := text (r,anzeigelaenge)
+ FI
+END PROC set anzeigetext;
+
+(*************** TeCal - Editor - Schnittstelle *****************)
+
+
+LET tecal tasten = "tq%()*+-/=CEFHKLMNRSVW^T"9"?",
+ funktionenliste = "LSCEFHKMNRVWtq%"9"T?" ,
+ zahlzeichen = "1234567890.,-+" ,
+ std tasten = "tqevw19dpgn"9"" ;
+
+LET kommando prozent = 15,
+ kommando clear = 3,
+ kommando einlesen = 4,
+ kommando formel = 5,
+ kommando recall = 7,
+ kommando lesen = 1,
+ kommando store = 8,
+ kommando naechste = 9,
+ kommando q = 14,
+ kommando runden = 10,
+ kommando schreiben= 2,
+ kommando umschalt = 13,
+ kommando ver sum = 11,
+ kommando fenster = 12,
+ kommando type = 17,
+ kommando help = 18;
+
+LET x screen size = 79,
+ y screen size = 24;
+
+FILE VAR tecal file;
+
+TEXT VAR record, input buffer;
+INT VAR record pos;
+
+PROC dateizeile lesen :
+ set busy indicator;
+ read record (tecal file, record);
+ record pos := col (tecal file)
+END PROC dateizeile lesen;
+
+PROC zahl aufsammeln :
+ dateizeile lesen;
+ REAL VAR zahl := pick up number (record, record pos);
+ IF last pick up ok THEN
+ push (zahl)
+ ELSE
+ errorstop ("Keine Zahl gefunden")
+ FI
+END PROC zahl aufsammeln;
+
+REAL PROC spaltensumme :
+
+ anfangsposition merken;
+ nach oben laufen und addieren;
+ zum anfang zurueck;
+ summe.
+
+nach oben laufen und addieren :
+ WHILE NOT oben angekommen REP
+ hochgehen und satz lesen;
+ record auswerten
+ PER.
+
+anfangsposition merken :
+ INT VAR alte zeile := line no (tecal file);
+ dateizeile lesen;
+ REAL VAR summe := pick up number (record,record pos);
+ BOOL VAR weiterlaufen := TRUE
+ IF NOT last pick up ok THEN
+ summe := 0.0
+ FI.
+
+zum anfang zurueck :
+ to line (tecalfile, alte zeile).
+
+hochgehen und satz lesen :
+ up (tecal file);
+ read record (tecal file, record).
+
+oben angekommen : line no (tecalfile) = 1 COR NOT weiterlaufen.
+
+record auswerten :
+ IF blankzeile THEN
+ weiterlaufen := TRUE
+ ELIF kein zahlzeichen THEN
+ weiterlaufen := FALSE
+ ELSE
+ summe INCR pick up number (record,record pos);
+ weiterlaufen := last pick up ok
+ FI.
+
+blankzeile : LENGTH record < record pos COR (record SUB record pos) = " ".
+
+kein zahlzeichen : pos (zahlzeichen,record SUB recordpos) = 0.
+
+END PROC spaltensumme;
+
+PROC tecal (TEXT CONST filename) :
+ type (""27"t");
+ edit (filename).
+
+END PROC tecal;
+
+PROC tecal :
+ IF groesster editor > 0
+ THEN tecal auf editfile
+ ELSE tecal (lastparam)
+ FI.
+
+tecal auf editfile :
+ FILE VAR f := editfile;
+ quit;
+ tecal (f) .
+
+END PROC tecal;
+
+PROC tecal (FILE VAR ed file) :
+ enable stop ;
+ open editor (groesster editor + 1, ed file, TRUE,
+ 1, 1, x screen size, y screen size - 1);
+ show status line;
+ edit (groesster editor, tecal tasten + std tasten,
+ PROC (TEXT CONST) tecal interpreter) .
+
+END PROC tecal;
+
+PROC tecal interpreter (TEXT CONST symbol) :
+
+ tecal file := editfile ;
+ nichts neu ;
+ INT VAR kommando := pos (operatorenliste,symbol);
+ IF kommando > 0 THEN
+ normale rechenoperation
+ ELSE kommando := pos (funktionenliste,symbol);
+ sonderfunktion
+ FI.
+
+normale rechenoperation :
+ IF operand expected CAND keine klammer auf THEN
+ zahl aufsammeln
+ FI;
+ push (kommando);
+ display value.
+
+keine klammer auf : symbol <> "(".
+
+sonderfunktion :
+ SELECT kommando OF
+ CASE kommando prozent : do prozent
+ CASE kommando clear : do clear
+ CASE kommando einlesen : do get
+ CASE kommando formel : do formelrechnung
+ CASE kommando ver sum : do spaltensumme
+ CASE kommando recall : do speicher lesen
+ CASE kommando lesen : do zahl aufsammeln
+ CASE kommando store : do speicher schreiben
+ CASE kommando naechste : do zur naechsten zahl
+ CASE kommando q : quit
+ CASE kommando runden : do runden
+ CASE kommando schreiben: do schreiben
+ CASE kommando umschalt : do tecal abschalten
+ CASE kommando type : do type displayed value
+(* CASE kommando hor sum : calculate ver sum*)
+ CASE kommando fenster : do fenster als zweiten operanden
+(* CASE kommando tab : calculate tab sum *)
+ CASE kommando help : do ("tecal auskunft")
+ OTHERWISE : std kommando interpreter (symbol)
+ END SELECT.
+
+do prozent :
+ IF operand expected THEN
+ zahl aufsammeln
+ FI;
+ do (REAL PROC (REAL CONST) prozent);
+ display value.
+
+do clear :
+ clear;
+ ueberschrift neu;
+ show status line.
+
+do get :
+ input buffer := "";
+ get expression (input buffer);
+ IF input buffer > " " THEN
+ disable stop;
+ superklammer auf;
+ evaluate (input buffer);
+ superklammer zu;
+ show status line;
+ enable stop;
+ ELSE
+ show status line
+ FI.
+
+do zahl aufsammeln :
+ zahl aufsammeln;
+ display value.
+
+do speicher schreiben :
+ merke (result);
+ show status line.
+
+do type displayed value :
+ set anzeigetext (result);
+ push(compress(anzeigetext)).
+
+do speicher lesen :
+ push (speicher);
+ display value.
+
+do spaltensumme :
+ push (spaltensumme);
+ display value.
+
+do formelrechnung :
+ dateizeile lesen;
+ disable stop;
+ superklammer auf;
+ evaluate (record);
+ superklammer zu;
+ enable stop;
+ display value;
+ IF enthaelt gleichzeichen CAND NOT empty THEN
+ ergebnis dahinter schreiben
+ ELSE
+ col (LENGTH record + 1)
+ FI.
+
+enthaelt gleichzeichen :
+ INT VAR gleichpos := pos (record,"=");
+ gleichpos > 0.
+
+ergebnis dahinter schreiben :
+ record pos := gleichpos + 2 + decimal exponent (result);
+ gleich pos := pos (record, ".", recordpos + 1) -1;
+ IF gleichpos > 0 THEN
+ record pos := gleichpos
+ FI;
+ ergebnis eintragen und dateizeile zurueckschreiben.
+
+ergebnis eintragen und dateizeile zurueckschreiben :
+ replace number (record, result, record pos, nachkommastellen);
+ write record (tecal file, record);
+ zeile neu;
+ col (record pos).
+
+do zur naechsten zahl :
+ dateizeile lesen;
+ record pos := pos (record,"0","9",record pos);
+ IF record pos = 0 THEN
+ record pos := LENGTH record + 1
+ FI;
+ col (record pos).
+
+do schreiben :
+ IF NOT empty THEN
+ dateizeile lesen;
+ ergebnis eintragen und dateizeile zurueckschreiben
+ FI.
+
+do runden :
+ IF NOT empty AND NOT operand expected THEN
+ do (REAL PROC (REAL CONST) runden)
+ FI.
+
+do fenster als zweiten operanden :
+ IF empty THEN
+ push (0.0)
+ ELSE
+ push (result)
+ FI.
+
+do tecal abschalten :
+ quit;
+ edit (tecalfile).
+
+END PROC tecal interpreter;
+
+clear;
+kommando auf taste legen ("t","tecal");
+(*kommando auf taste legen ("?","tecalauskunft");*)
+
+END PACKET tecal functions;
+
diff --git a/app/tecal/1.8.7/src/TeCal Auskunft b/app/tecal/1.8.7/src/TeCal Auskunft
new file mode 100644
index 0000000..9468265
--- /dev/null
+++ b/app/tecal/1.8.7/src/TeCal Auskunft
Binary files differ
diff --git a/app/tecal/1.8.7/src/TeCal.gen b/app/tecal/1.8.7/src/TeCal.gen
new file mode 100644
index 0000000..c670db7
--- /dev/null
+++ b/app/tecal/1.8.7/src/TeCal.gen
@@ -0,0 +1,55 @@
+LET tecal = "TeCal",
+ auskunft = "TeCal Auskunft";
+
+IF NOT exists ("TeCal") THEN fetch ("TeCal",archive) FI;
+IF NOT exists ("TeCal Auskunft") THEN fetch ("TeCal Auskunft",archive) FI;
+
+checkoff;
+insert tecal;
+insert auskunft;
+shorten auskunft file;
+forget ("Tecal.gen", quiet).
+
+insert tecal :
+ display (""13""10""15" TeCal-Rechner wird installiert "14""13""10"");
+ insert (tecal);
+ forget (tecal, quiet).
+
+insert auskunft:
+ display (""13""15" TeCal-Auskunftfile wird installiert "14""13""10"");
+ insert (auskunft).
+
+shorten auskunft file :
+ display (""13""10""15" TeCal-Auskunftfile wird komprimiert "14""13""10"");
+ disable stop;
+ DATASPACE VAR dspace := nil space;
+ FILE VAR file := sequential file ( input, auskunft),
+ shorted:= sequential file (output, dspace);
+ TEXT VAR buffer;
+ INT VAR i;
+
+ WHILE NOT eof (file)
+ REPEAT get line (file, buffer)
+ UNTIL (pos ("(*", buffer) > 0) OR is error PER;
+ i:= 1;
+ IF eof (file) COR text not transfered
+ THEN errorstop ("TeCal-Auskunftsfile ist bereits komprimiert!"13""10"" +
+ "'ESC <?>' funktioniert wahrscheinlich nicht."13""10"" +
+ "Bitte ORIGINAL Auskunftsfile von Diskette verwenden")
+ ELSE forget (auskunft, quiet);
+ copy (dspace, auskunft)
+ FI;
+ forget (dspace) .
+
+ text not transfered :
+ WHILE NOT eof (file)
+ REPEAT cout (i);
+ get line (file, buffer);
+ IF pos (buffer, "*)") > 0
+ THEN LEAVE text not transfered WITH FALSE
+ ELSE put line (shorted, buffer)
+ FI;
+ i INCR 1
+ UNTIL is error PER;
+ TRUE .
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 17:55:23 +0000