From 724cc003460ec67eda269911da85c9f9e40aa6cf Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 30 Sep 2016 16:57:23 +0200 Subject: Add extracted sources from floppy disk images Some files have no textual representation (yet) and were added as raw dataspaces. --- tecal/TeCal | 856 +++++++++++++++++++++++++++++++++++++++++++++++++++ tecal/TeCal Auskunft | Bin 0 -> 45056 bytes tecal/TeCal.gen | 55 ++++ 3 files changed, 911 insertions(+) create mode 100644 tecal/TeCal create mode 100644 tecal/TeCal Auskunft create mode 100644 tecal/TeCal.gen (limited to 'tecal') diff --git a/tecal/TeCal b/tecal/TeCal new file mode 100644 index 0000000..0bcb18e --- /dev/null +++ b/tecal/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/tecal/TeCal Auskunft b/tecal/TeCal Auskunft new file mode 100644 index 0000000..9468265 Binary files /dev/null and b/tecal/TeCal Auskunft differ diff --git a/tecal/TeCal.gen b/tecal/TeCal.gen new file mode 100644 index 0000000..c670db7 --- /dev/null +++ b/tecal/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 . + -- cgit v1.2.3