diff options
Diffstat (limited to 'tecal')
| -rw-r--r-- | tecal/TeCal | 856 | ||||
| -rw-r--r-- | tecal/TeCal Auskunft | bin | 45056 -> 0 bytes | |||
| -rw-r--r-- | tecal/TeCal.gen | 55 |
3 files changed, 0 insertions, 911 deletions
diff --git a/tecal/TeCal b/tecal/TeCal deleted file mode 100644 index 0bcb18e..0000000 --- a/tecal/TeCal +++ /dev/null @@ -1,856 +0,0 @@ -(**********************************************************************) -(* *) -(* 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/tecal/TeCal Auskunft b/tecal/TeCal Auskunft Binary files differdeleted file mode 100644 index 9468265..0000000 --- a/tecal/TeCal Auskunft +++ /dev/null diff --git a/tecal/TeCal.gen b/tecal/TeCal.gen deleted file mode 100644 index c670db7..0000000 --- a/tecal/TeCal.gen +++ /dev/null @@ -1,55 +0,0 @@ -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 . - |